Sub subgen99()
Set ws1 = Sheets("Sheet1") 'change as necessary
Set ws2 = Sheets("Sheet2") ' "
ws2.Range("J2:" & ws2.Columns("J:Q").SpecialCells(11).Address).ClearContents ' clear the color table
n = ws2.Range("B1").Value ' the name to look for
Set c = ws1.Columns(2).Find(n, lookat:=xlWhole) 'search for the name
If Not c Is Nothing Then 'if the name is found
firstAdd = c.Address 'noting the first found cell
Do ' now we're gonna add data to the approiate columns using a Do Loop
Set d = c 'we need to do this b/c we're gonna search for the right color column
Set c = ws2.Rows(1).Find(c.Offset(0, 1).Value) ' look for the column color
If Not c Is Nothing Then
r = ws2.Cells(Rows.Count, c.Column).End(3).Row + 1 'The empty row in the color column
ws2.Cells(r, c.Column).Value = d.Offset(0, -1).Value 'the date
ws2.Cells(r, c.Column + 1).Value = d.Offset(0, 2).Value 'the amount
End If
Set c = ws1.Columns(2).Find(n, lookat:=xlWhole, after:=d) 'find the next name
Loop While Not c Is Nothing And c.Address <> firstAdd
End If
End Sub
Bookmarks