VBA to find most recent Invoice Date for each Customer

[Mikilive]

I'm working on a macro that eventually takes a 20,000 row worksheet down to under 5,000. One of the first issues I cannot figure out, or find an answer to, is how to remove all but the most recent invoice for each customer. Some of the customers could have 1 or 2 invoices where most have 4 per month. I've looked for Max Date Filters where I can filter out the max date per customer and remove the remaining rows but since I'm dealing with multiple rows of data for each customer I can't find a solution that works. Below is just a snip of the spreadsheet but for this example I would like to end up with only the rows dated 11/21/23 for customer 10093631 and rows dated 11/20/2023 for customer 10108607. There will be additional filtering, look ups and formulas written into the macro to replace a lot of manual work that is currently being done to get the data into shape so starting the macro with a solution to this issue would be preferable rather then pivots or formulas in excel.

Any help would be greatly appreciated.
Thank you

 

[kevin9999]

I tried your code and got a Type Mismatch on this section j = a(i + 1, 6)

Which tends to suggest the dates might be text that look like dates. Although you already have an accepted solution, have a try with the following amended code, which turned the sample used in post #6 into this:

Mikilive.xlsm
	A	B	C	D	E	F	G	H
1	Customer	Address	City	State	Service Ticket	Billing Date	Material Number	Value
2	10093631	3061 INTERSTATE PKWY	BRUNSWICK	OH	4174744550	11/21/2023	X2
3	10093631	3062 INTERSTATE PKWY	BRUNSWICK	OH	4174744550	11/21/2023	X1132
4	10093631	3063 INTERSTATE PKWY	BRUNSWICK	OH	4174744550	11/21/2023	X106
5	10108607	834 BESSEMER ST	MEADVILLE	PA	4174336983	11/20/2023	X2
6	10108607	835 BESSEMER ST	MEADVILLE	PA	4174336983	11/20/2023	X1132
7	10108607	836 BESSEMER ST	MEADVILLE	PA	4174336983	11/20/2023	X106
8
Sheet1

Amended code:

Option Explicit
Sub Mikilive_V2()
    Application.ScreenUpdating = False
    Dim ws As Worksheet, LRow As Long, LCol As Long
    Set ws = Worksheets("Sheet1")                   '<-- *** Change to actual sheet name ***
    LRow = ws.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
    LCol = ws.Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column + 1
   
    With ws
        .Columns("A:H").Sort Key1:=.Range("A1"), order1:=xlAscending, _
        Key2:=.Range("F1"), order2:=xlAscending, Header:=xlYes
    End With
   
    Dim a, b, i As Long, s As String
    a = ws.Range("A2:H" & LRow)
    ReDim b(1 To UBound(a, 1), 1 To 1)
    For i = UBound(a, 1) - 1 To 1 Step -1
        If s = "" Then s = a(i + 1, 6)
        If a(i, 1) <> a(i + 1, 1) Then s = a(i, 6)
        If a(i, 1) = a(i + 1, 1) And a(i, 6) <> s Then b(i, 1) = 1
    Next i
   
    ws.Cells(2, LCol).Resize(UBound(b, 1)).Value = b
    i = WorksheetFunction.Sum(ws.Columns(LCol))
    If i > 0 Then
        ws.Range(ws.Cells(2, 1), ws.Cells(LRow, LCol)).Sort Key1:=ws.Cells(2, LCol), _
        order1:=xlAscending, Header:=xlNo
        ws.Cells(2, LCol).Resize(i).EntireRow.Delete
    End If
    Application.ScreenUpdating = True
End Sub