delete rows based based on two criteria

[tourless]

Hi Folks,

I have a list of customers in column A. Each customer can appear multiple times. Column C contains dates (mm/dd/yyyy), formatted as 'general'. The list is sorted by customer name (a-z), then by date. In a macro, I'd like to remove all but the latest date for each customer essentially turning this...

Customer A 431604 6/11/2018
Customer A 431604 6/11/2018
Customer A 431604 6/11/2018
Customer A 432684 6/14/2018
Customer A 432684 6/14/2018
Customer A 432684 6/14/2018
Customer B 434075 6/11/2018
Customer B 434075 6/12/2018
Customer B 434075 6/13/2018
Customer B 434075 6/14/2018
Customer C 432611 6/15/2018
Customer C 432611 6/15/2018
Customer C 432611 6/15/2018
Customer D 435261 6/15/2018
Customer D 435261 6/15/2018
Customer D 435261 6/16/2018
Customer D 435261 6/16/2018

into this...

Customer A 432684 6/14/2018
Customer A 432684 6/14/2018
Customer A 432684 6/14/2018
Customer B 434075 6/14/2018
Customer C 432611 6/15/2018
Customer C 432611 6/15/2018
Customer C 432611 6/15/2018
Customer D 435261 6/16/2018
Customer D 435261 6/16/2018

Here's what I'm working with and it seems to only leave the latest date entries regardless of customer name.

Dim customerRng As Range
    Dim customerRow As Range
    Dim i As Long
    Dim data As Range
    
    Set customerRng = wsCustomerList.Range("A1:A" & LastRow(wsCustomerList))
    
    wsDeliveryList.Activate
    wsDeliveryList.Range("A1:O" & LastRow(wsDeliveryInfo)).Delete Shift:=xlUp
    
    wsDeliveryInfo.Range("A2:M" & LastRow(wsDeliveryInfo)).SpecialCells(xlCellTypeVisible).Cells.Copy
    wsDeliveryList.Range("A1").PasteSpecial xlPasteValues
    
    'Extract date format
    wsDeliveryList.Range("O1:O" & LastRow(wsDeliveryList)).Formula = "= Text(C1,""m/d/yyyy"")"
    'Copy and paste the extracted values
    wsDeliveryList.Range("O1:O" & LastRow(wsDeliveryList)).Copy
    wsDeliveryList.Range("C1").PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    
    ActiveWorkbook.Worksheets("DeliveryList").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("DeliveryList").Sort.SortFields.Add Key:=Worksheets("DeliveryList").Range( _
        "A1:A23138"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    ActiveWorkbook.Worksheets("DeliveryList").Sort.SortFields.Add Key:=Worksheets("DeliveryList").Range( _
        "C1:C23138"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("DeliveryList").Sort
        .SetRange Range("A1:M23138")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    For Each customerRow In customerRng.Rows
        Set data = wsDeliveryList.Range("C1:C" & LastRow(wsDeliveryList))
        For i = data.Rows.Count To 2 Step -1
            If wsDeliveryList.Range("C" & i - 1) < wsDeliveryList.Range("C" & i) Then
                wsDeliveryList.Range("C" & i - 1).EntireRow.Delete Shift:=xlUp
            End If
        Next i
    Next customerRow

End Sub

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG21Jun08
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Delrng [COLOR="Navy"]As[/COLOR] Range, nRng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Set[/COLOR] Rng = Range("A1", Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] Not .exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
        .Add Dn.Value, Dn.Offset(, 2)
    [COLOR="Navy"]Else[/COLOR]
       [COLOR="Navy"]If[/COLOR] Dn.Offset(, 2) > .Item(Dn.Value) [COLOR="Navy"]Then[/COLOR]
          [COLOR="Navy"]Set[/COLOR] .Item(Dn.Value) = Dn.Offset(, 2)
        [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] Not Dn.Offset(, 2) = .Item(Dn.Value) [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]If[/COLOR] nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR] [COLOR="Navy"]Set[/COLOR] nRng = Dn Else [COLOR="Navy"]Set[/COLOR] nRng = Union(nRng, Dn)
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]If[/COLOR] Not nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR] nRng.EntireRow.Delete
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[tourless]

Perfect! Thanks Mick!