Consulting

Results 1 to 3 of 3

Thread: Extract matching data values and copy to new location

  1. #1

    Extract matching data values and copy to new location

    Hi

    New to VBA and hit a bit of a brick wall - so it's back to the board.

    I have list of candidates (placed in 3 groups) who get a a code 'S', 'L, 'N' for each task performed. Since the list of candidates (for each group) can vary … this is where I think the code is tripping up.

    All I am trying to do is extract the list of candidates from each group 1,2,3 who have either/or the codes 'S' and/or 'L' (so S and S, S and L, L and S or L and L).

    The first group pastes fine but since the code is looking for where group 2/3 starts, I think this is where the issue is? (Also, being new, I may have cut a few corners in the code to make it work, not sure.)


    Can someone help? File attached and thanks in advance.
    Attached Files Attached Files
    Last edited by branston; 04-17-2019 at 07:57 AM.

  2. #2
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,443
    Location
    Try this

    Sub CreateGroups()
    
    
        Application.ScreenUpdating = False
        Dim lastrow As Long, GR2 As Long, GR3 As Long, code As Range
        lastrow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        GR2 = Range("O:O").Find("GROUP 2").Row
        GR3 = Range("O:O").Find("GROUP 3").Row
        With Range("Y11:AL" & lastrow)
            .Borders.LineStyle = xlNone
            .ClearContents
        End With
        
        'Group1 ('S OR L' for TaskA, 'S OR L' for TaskB)
        For Each code In Range("P11:P" & GR2 - 3)
            If code = "S" Or code = "L" Then
                Set fname1 = Range("O11:S" & GR2 - 3).Find(code.Offset(0, -1))
                Set fname2 = Range("S11:S" & GR2 - 3).Find(code.Offset(0, -1))
                If Not fname1 Is Nothing Then
                    If fname1.Offset(0, 1) = "S" Or fname1.Offset(0, 1) = "L" Then
                        If fname2.Offset(0, 1) = "S" Or fname2.Offset(0, 1) = "L" Then
                            Cells(Rows.Count, "Z").End(xlUp).Offset(1, 0) = code.Offset(0, -1)
                            Cells(Rows.Count, "AA").End(xlUp).Offset(1, 0) = fname1.Offset(0, 1)
                            Cells(Rows.Count, "AB").End(xlUp).Offset(1, 0) = fname2.Offset(0, 1)
                        End If
                    End If
                End If
            End If
        Next code
        
        With Range("Y11")
            .value = 1
            .AutoFill Destination:=Range("Y11").Resize(Range("Z" & Rows.Count).End(xlUp).Row - 3), Type:=xlFillSeries
            .Resize(Range("Z" & Rows.Count).End(xlUp).Row - 3, 4).Borders.LineStyle = xlContinuous
        End With
        
        'Group2 ('S OR L' for TaskA, 'S OR L' for TaskB)
        For Each code In Range("P" & GR2 + 1 & ":P" & GR3 - 3)
            If code = "S" Or code = "L" Then
                Set fname1 = Range("O" & GR2 + 1 & ":O" & GR3 - 3).Find(code.Offset(0, -1))
                Set fname2 = Range("S" & GR2 + 1 & ":S" & GR3 - 3).Find(code.Offset(0, -1))
                    If Not fname1 Is Nothing Then
                        If fname1.Offset(0, 1) = "S" Or fname1.Offset(0, 1) = "L" Then
                            If fname2.Offset(0, 1) = "S" Or fname2.Offset(0, 1) = "L" Then
                                Cells(Rows.Count, "AE").End(xlUp).Offset(1, 0) = code.Offset(0, -1)
                                Cells(Rows.Count, "AF").End(xlUp).Offset(1, 0) = fname1.Offset(0, 1)
                                Cells(Rows.Count, "AG").End(xlUp).Offset(1, 0) = fname2.Offset(0, 1)
                            End If
                        End If
                    End If
                End If
         Next code
        
        With Range("AD11")
            .value = 1
            .AutoFill Destination:=Range("AD11").Resize(Range("AE" & Rows.Count).End(xlUp).Row - 3), Type:=xlFillSeries
            .Resize(Range("AE" & Rows.Count).End(xlUp).Row - 3, 4).Borders.LineStyle = xlContinuous
        End With
        
        'Group3 ('S OR L' for TaskA, 'S OR L' for TaskB)
        For Each code In Range("P" & GR3 + 1 & ":P" & lastrow)
            If code = "S" Or code = "L" Then
                Set fname1 = Range("O" & GR3 + 1 & ":O" & lastrow).Find(code.Offset(0, -1))
                Set fname2 = Range("S" & GR3 + 1 & ":S" & lastrow).Find(code.Offset(0, -1))
                    If Not fname1 Is Nothing Then
                        If fname1.Offset(0, 1) = "S" Or fname1.Offset(0, 1) = "L" Then
                            If Not fname2 Is Nothing Then
                                If fname2.Offset(0, 1) = "S" Or fname2.Offset(0, 1) = "L" Then
                                    Cells(Rows.Count, "AJ").End(xlUp).Offset(1, 0) = code.Offset(0, -1)
                                    Cells(Rows.Count, "AK").End(xlUp).Offset(1, 0) = fname1.Offset(0, 1)
                                    Cells(Rows.Count, "AL").End(xlUp).Offset(1, 0) = fname2.Offset(0, 1)
                                End If
                            End If
                        End If
                    End If
            End If
        Next code
        
        With Range("AI11")
            .value = 1
            .AutoFill Destination:=Range("AI11").Resize(Range("AJ" & Rows.Count).End(xlUp).Row - 3), Type:=xlFillSeries
            .Resize(Range("AJ" & Rows.Count).End(xlUp).Row - 3, 4).Borders.LineStyle = xlContinuous
        End With
        
        Application.ScreenUpdating = True
    End Sub
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  3. #3
    That seems to have sorted it - thanks xld.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •