Keep the bigget progressive number in a list VBA or Formula

[jevi]

Dear All,

I have this two columns and I would like to keep only the biggest progressive number in column B based on the unique value of column A. I have a list of 30.000 rows and the progressive number of column be is from 1-105.

So the result I want is to the keep the biggest progressive number based on the unique Client Code so for the client 56097 I want to keep the second row with value 2, then for the client 56101 I would like to keep the 5 row with the value 3 in the Column B and so on.

Any help much aprecciated .
Thank you,

Column A Column B
Client Code Progressive Number

 

[Peter_SSs]

My suggestion has a couple of differences.
- For my test data of 30,000 rows this is about twice as fast
- For the data rows retained, this will preserve any formatting, formulas etc in those rows.

Sub Biggest()
  Dim a As Variant, b As Variant
  Dim i As Long, k As Long, nc As Long
 
  nc = Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
  a = Range("A2", Range("A" & Rows.Count).End(xlUp).Offset(1)).Value
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a) - 1
    If a(i, 1) = a(i + 1, 1) Then
      b(i, 1) = 1
      k = k + 1
    End If
  Next i
  If k > 0 Then
    Application.ScreenUpdating = False
    With Range("A2").Resize(UBound(a), nc)
      .Columns(nc).Value = b
      .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlNo
      .Resize(k).EntireRow.Delete
    End With
    Application.ScreenUpdating = True
  End If
End Sub

 

[jevi]

Peter_SSs,

It worked great...I will have rows with 100.000 of data so is much needed this macro. thank you so much

 

[jevi]

whoops sorry my mistake, try this:

Sub test2()
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
inarr = Range(Cells(1, 1), Cells(LastRow, 15))
Range(Cells(1, 1), Cells(LastRow, 15)) = ""
outarr = Range(Cells(1, 1), Cells(LastRow, 15))
indi = 1
curv = inarr(1, 1) ' initail value
For i = 2 To LastRow
   If curv <> inarr(i, 1) Then
     For j = 1 To 15
        outarr(indi, j) = inarr(i - 1, j)
     Next j
    curv = inarr(i, 1)
    indi = indi + 1
  End If
Next i
Range(Cells(1, 1), Cells(indi, 15)) = outarr

End Sub

It worked great. Thank you so much for your help and sorry for making you re-writing your macro.

 

[Peter_SSs]

You're welcome. Glad we could help.