# Keep the bigget progressive number in a list VBA or Formula

#### jevi

##### Active Member
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

##### MrExcel MVP, Moderator
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.

VBA Code:
``````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
.Resize(k).EntireRow.Delete
End With
Application.ScreenUpdating = True
End If
End Sub``````

### Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December

#### jevi

##### Active Member
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

##### Active Member
whoops sorry my mistake, try this:
VBA Code:
``````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

##### MrExcel MVP, Moderator
You're welcome. Glad we could help.

Replies
3
Views
61
Replies
1
Views
262
Replies
6
Views
117
Replies
1
Views
392
Replies
9
Views
138

1,127,529
Messages
5,625,352
Members
416,096
Latest member
forevans

### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.

### Which adblocker are you using?

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back