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]

What version of Excel are you using? You might be able to use the Maxifs() function if you're on 2019 onwards. Also, could you please provide a copy of your data using the XL2BB addin, or alternatively share your file via Google Drive, Dropbox or similar file sharing platform, as we cannot copy from an image to test possible solutions.

 

[jimrward]

If I were doing this my thoughts would be as follows
Sort the data by customer ascending and date descending to float the recent ones to the top of each list
I would then use a helper column to set to 0 or 1
Assuming your data is column A to H
In column I the formula would compare the current customer with the previous and if different set flag to 1, the first of a new batch effectively
If the customer is the same then check the date if the same as the one above then 1 else 0
You will be left with a column of 0’s and 1’s
Filter to keep the 1’s and select and copy to destination
I am not on my pc at the moment
But I will attempt the IF
In I2
=IF(A2<>A1,1,IF(AND(A2=A1,F2=F1),1,0)
And copy down

 

[jimrward]

Ok it might need an additional condition added to the IF to stop similar groups being flagged in the middle of the data for a customer
=IF(A2<>A1,1,IF(AND(A2=A1,F2=F1, I1=1),1,0)
I will test later with some data

 

[kevin9999]

Please try the following on a copy of your workbook. I can't tell from your image, so I'm assuming row 1 is the header row, your customer numbers are in column A, and your dates are in column F. Just change the sheet name in the code to the actual sheet name.

Option Explicit
Sub Mikilive()
    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, j As Long
    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 j = 0 Then j = a(i + 1, 6)
        If a(i, 1) <> a(i + 1, 1) Then j = a(i, 6)
        If a(i, 1) = a(i + 1, 1) And a(i, 6) < j 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

 

[jimrward]

Ok here is your data copied and sorted by Customer Ascending and Date Descending to float the latest to the top of the group with helper flag column populated

MrExcelCustList.xlsx
	A	B	C	D	E	F	G	H	I
1	Customer	Address	City	State	Service Ticket	Billing Date	Material Number	Value	Flag
2	10093631	3061 INTERSTATE PKWY	BRUNSWICK	OH	4174744550	11/21/2023	X2		1
3	10093631	3062 INTERSTATE PKWY	BRUNSWICK	OH	4174744550	11/21/2023	X1132		1
4	10093631	3063 INTERSTATE PKWY	BRUNSWICK	OH	4174744550	11/21/2023	X106		1
5	10093631	3058 INTERSTATE PKWY	BRUNSWICK	OH	4174056367	11/15/2023	X2		0
6	10093631	3059 INTERSTATE PKWY	BRUNSWICK	OH	4174056367	11/15/2023	X1132		0
7	10093631	3060 INTERSTATE PKWY	BRUNSWICK	OH	4174056367	11/15/2023	X106		0
8	10093631	3055 INTERSTATE PKWY	BRUNSWICK	OH	4173330159	11/08/2023	X2		0
9	10093631	3056 INTERSTATE PKWY	BRUNSWICK	OH	4173330159	11/08/2023	X1132		0
10	10093631	3057 INTERSTATE PKWY	BRUNSWICK	OH	4173330159	11/08/2023	X106		0
11	10093631	3052 INTERSTATE PKWY	BRUNSWICK	OH	4172608285	11/01/2023	X2		0
12	10093631	3053 INTERSTATE PKWY	BRUNSWICK	OH	4172608285	11/01/2023	X1132		0
13	10093631	3054 INTERSTATE PKWY	BRUNSWICK	OH	4172608285	11/01/2023	X106		0
14	10108607	834 BESSEMER ST	MEADVILLE	PA	4174336983	11/20/2023	X2		1
15	10108607	835 BESSEMER ST	MEADVILLE	PA	4174336983	11/20/2023	X1132		1
16	10108607	836 BESSEMER ST	MEADVILLE	PA	4174336983	11/20/2023	X106		1
17	10108607	831 BESSEMER ST	MEADVILLE	PA	4173661587	11/13/2023	X2		0
18	10108607	832 BESSEMER ST	MEADVILLE	PA	4173661587	11/13/2023	X1132		0
19	10108607	833 BESSEMER ST	MEADVILLE	PA	4173661587	11/13/2023	X106		0
20	10108607	825 BESSEMER ST	MEADVILLE	PA	4172235917	10/30/2023	X2		0
21	10108607	826 BESSEMER ST	MEADVILLE	PA	4172235917	10/30/2023	X1132		0
22	10108607	827 BESSEMER ST	MEADVILLE	PA	4172235917	10/30/2023	X106		0
23	10108607	828 BESSEMER ST	MEADVILLE	PA	4172946645	11/06/2023	X2		0
24	10108607	829 BESSEMER ST	MEADVILLE	PA	4172946645	11/06/2023	X1132		0
25	10108607	830 BESSEMER ST	MEADVILLE	PA	4172946645	11/06/2023	X106		0
Sheet2

Cell Formulas
Range	Formula
I2:I25	I2	=IF(A2<>A1,1,IF(AND(A2=A1,F2=F1,I1=1),1,0))

Named Ranges
Name	Refers To	Cells
_FilterDatabase	=Sheet2!$A$1:$I$25	I2

 

[mumps]

Try:

Sub deleteRows()
    Application.ScreenUpdating = False
    Dim v As Variant, i As Long, dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    Columns("A:H").Sort Key1:=Range("A1"), order1:=xlAscending, Key2:=Range("F1"), order2:=xlAscending, Header:=xlYes
    v = Range("A2", Range("A" & Rows.Count).End(xlUp)).Value
    For i = LBound(v) To UBound(v)
        If Not dic.exists(v(i, 1)) Then
            dic.Add v(i, 1), Nothing
            Range("A1").CurrentRegion.AutoFilter 1, v(i, 1)
            fvisrow = Range("A2", Cells(Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row
            lvisrow = Cells(Rows.Count, "A").End(xlUp).Row
            Rows(fvisrow & ":" & lvisrow - 1).Delete
        End If
    Next i
    Range("A1").AutoFilter
    Application.ScreenUpdating = True
End Sub

 

[Mikilive]

Thank you all for your input. I tried loading a mini sheet but I can't get the xl2bb to work even after following the trouble shooting suggestions.

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

@mumps I tried your code and it worked to get the last date but it deleted all except one row of data for each invoice. I need to keep all rows of data for the max invoice dates.

@jimrward Your formula works, I'll try using it on the large data set and see about working the steps into the macro. This may be the easiest route, since the actual data set can be very large, deleting rows takes time, with your formula I should be able to sort the results, filter to 0, clear contents then delete the rows. Probably overkill, but I've had many instances of excel bombing out when trying to delete mass lines of data.

Thank you!

 

[jimrward]

@Mikilive I chose the formula approach as you can always undo your step and get your data back, using a macro its a one way method unless you have a backup of your data
You can also see the 1's for the required data and the zeros for the data to discard
I would be wary about sorting the final output as it might chew up the formulas, filtering on the flag column might be better and then cut and paste value only

 

[Mikilive]

@Mikilive I chose the formula approach as you can always undo your step and get your data back, using a macro its a one way method unless you have a backup of your data
You can also see the 1's for the required data and the zeros for the data to discard
I would be wary about sorting the final output as it might chew up the formulas, filtering on the flag column might be better and then cut and paste value only

Thanks! I normally CPV anytime I have a formula in a macro, and the data will be a copy of the original so I'm not worried about compromising it.