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.

Try this

Code:

---

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

---

That seems to have sorted it - thanks xld.