Date limit on formatting.

[sungen99]

I am trying to add some new flexibility to an existing macro but have been unable to do it successfully.

As it stands now the macro will take the Name on Sheet2 B1, and then sort through the data in Sheet1 and nicely format it by color back on Sheet2 J1:Q.

I now need to be able to limit the date using B2 on Sheet2. So if the data being worked on is greater than that date it should skip it.

Thank you.

[PCI]

Try twice (at least ) and comment

Sub subgen99()
Set ws1 = Sheets("Sheet1") 'change as necessary
Set ws2 = Sheets("Sheet2") ' "
Dim Max_Date  As Date, WkDate As Date
ws2.Range("J2:" & ws2.Columns("J:Q").SpecialCells(11).Address).ClearContents ' clear the color table

dt = ws1.Range("J1").Value
n = ws2.Range("B1").Value ' the name to look for
Max_Date = ws2.[B2]

   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
               If (d.Offset(0, -1) <= Max_Date) 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
           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

[sungen99]

Works perfectly. Thank you!