PDA

View Full Version : [SOLVED] Extract matching data values and copy to new location



branston
04-17-2019, 07:22 AM
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.

Bob Phillips
04-17-2019, 09:49 AM
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

branston
04-17-2019, 09:59 AM
That seems to have sorted it - thanks xld.