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

 

[offthelip]

You haven't stated where you want the results so I have put them in columns C and D
try this code:

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

End Sub

 

[maabadi]

Try This. With CTRL+SHIFT+ENTER

Book1
	A	B	C	D	E	F
1				Unique Items	Max Value
2	56097	1		56097	3
3	56097	2		56099	2
4	56097	3		56101	4
5	56099	1			0
6	56099	2			0
7	56101	1
8	56101	2
9	56101	3
10	56101	4
11
Data USD

Cell Formulas
Range	Formula
D2:D6	D2	=IFERROR(INDEX($A$2:$A$10,MATCH(0,COUNTIF($D$1:D1,$A$2:$A$10),0)),"")
E2:E6	E2	=IFERROR(MAX(($A$2:$A$10=$D2)*B2:B10),"")
Press CTRL+SHIFT+ENTER to enter array formulas.

 

[jevi]

hi OfftheLip,

My fault that I didn't explain well...I wanted to delete the other rows and keep only the one that give the result I want as I need to work with only that data.

The data are from column A to O but the one who decide to delete are according to the rule I mentioned above.

thank you

 

[maabadi]

@jevi Are you tested my formulas? What about them?

 

[offthelip]

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
    outarr(indi, 1) = curv
    outarr(indi, 2) = inarr(i - 1, 2)
    curv = inarr(i, 1)
    indi = indi + 1
  End If
Next i
Range(Cells(1, 1), Cells(indi, 15)) = outarr

End Sub

 

[jevi]

Maabi,
Sorry I was going to reply but had a busy day. They work perfectly as I tried them but the file is too big as has a lot of data and with the formulas takes too much time. Still, great to know them

 

[jevi]

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
    outarr(indi, 1) = curv
    outarr(indi, 2) = inarr(i - 1, 2)
    curv = inarr(i, 1)
    indi = indi + 1
  End If
Next i
Range(Cells(1, 1), Cells(indi, 15)) = outarr

End Sub

Thank you Offthelip. Now I am home and I don't have the file but I will try it tomorrow and let you know. Thank you so much.

 

[jevi]

Hi Offthelip,
I did try...it is almost perfect, but is deleting the other data that i have in the other columns after A and B column. I need them also. It needs to delete the rows as it does and leave the data in the other columns.

Sorry for confusing you.
Thank you

 

[offthelip]

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