# Find maximum given a certain value in another column

#### Agamemnon

##### Board Regular
Hi,

I have a feeling this question is already answered a few times, but I probably use the wrong key words for an effective search.

Problem:

I have a worksheet with two columns
ColA ColB
Rep1 10
Rep2 20
Rep2 25
Rep3 55
Rep3 45
Rep4 7
Rep4 8
Rep4 4

Now I want to copy the rows with the maximum value in Column B, given the values in Column A to a new worksheet

Result on new Sheet
ColA ColB
Rep1 10
Rep2 25
Rep3 55
Rep4 8

How can I do this with a VBA macro solution?
Thx for helping me out
Aga

### Excel Facts

How to calculate loan payments in Excel?
Use the PMT function: =PMT(5%/12,60,-25000) is for a \$25,000 loan, 5% annual interest, 60 month loan.
see the formula in B13 to B16 in the sheet below
type the formula in B13 and copy down
INVOKE FORMULA BY CONTROL+SHIFT+ENTER.
Book1
ABCD
1Rep110
2Rep220
3Rep225
4Rep355
5Rep345
6Rep47
7Rep48
8Rep44
9
10
11
12
13Rep110
14Rep225
15Rep355
16Rep48
Sheet1

A formula approach...

Assuming that A2:B9 contains the data, try...

D2, copied down:

=IF(OR(ISNUMBER(MATCH(TRUE,ISNA(MATCH(\$A2:\$A\$9,\$D\$1:D1,0)),0))),INDEX(\$A2:\$A\$9,MATCH(TRUE,ISNA(MATCH(\$A2:\$A\$9,\$D\$1:D1,0)),0)),"")

E2, copied down:

=IF(D2<>"",MAX(IF(\$A\$2:\$A\$9=D2,\$B\$2:\$B\$9)),"")

Both formulas need to be confirmed with CONTROL+SHIFT+ENTER, not just ENTER.

Hope this helps!

But does anyone have idea how to translate this procedure into VBA Code.

Aga

Does anyone has a VBA solution for this.

The problem is that the solution given with array formulas is very slow and I think even limited in data amount (I have over 6000 rows that must be evaluated, with more than 2000 conditions).

Thx for helping me out.
Aga

copying the array formula is not difficult.
the firs array formula is invoked with control+shift+enter then you can just copy the formula down the cells upto 3000 or een 30000. But if you prefer macro :

The macro is given below
The result of the macro is in coli D and E in the sample sheet below
Actually it will park the unique values of column A in last plus two columns of the data base and the max in the next column.
You can again run the macro because the macro-results columns are deleted and the macro is again run. see comments in code statements.

The macro is

Code:
``````Sub test()
Dim rng, rng1, c As Range
Dim j, i, k As Integer
Set rng = Range(Range("a1"), Range("a1").End(xlDown))
'j = Cells(1, Columns.Count).End(xlToLeft).Column
j = Range("a1").End(xlToRight).Column
'j is the last column before the macro
'MsgBox j
Range(Cells(1, j + 2), Cells(Rows.Count, Columns.Count)).Delete
'the above line is only to undo the results of the macro and test again.
rng.AdvancedFilter action:=xlFilterCopy, copytorange:=Cells(1, j + 2), unique:=True
'the above advanced filter is to get unique values of column A.
Cells(1, j + 3) = "max"
Set rng1 = Range(Cells(2, j + 2), Cells(2, j + 2).End(xlDown))
For Each c1 In rng1
For Each c In rng
If c1 = c Then x = WorksheetFunction.Max(x, c.Offset(0, 1).Value)
Next c
c1.Offset(0, 1) = x
x = 0
Next c1
MsgBox "macro is over"
End Sub``````

the sheet after running the macro is given below
book 4 oct 06.xls
ABCDE
1h1h2h1max
2Rep110Rep110
3Rep220Rep225
4Rep225Rep355
5Rep355Rep48
6Rep345rept514
7Rep47rept65
8Rep48
9Rep44
10rept514
11rept51
12rept52
13rept54
14rept65
15
Sheet1

Hi
No sort required
Code:
``````Sub test()
Dim a, dic As Object, i As Long
Set dic = createObject("Scripting.Dictionary")
a = Range("a1").CurrentRegion.Resize(,2).Value
For i = 1 To UBound(a,1)
If Not IsEmpty(a(i,1)) Then
If Not dic.exists(a(i,1)) Then
Else
dic(a(i,1)) = WorksheetFunction.Max(dic(a(i,1)),a(i,2))
End If
End If
Next
Range("d1").Resize(dic.count).Value = Application.Transpose(dic.keys)
Range("e1").Resize(dic.count).Value = Application.Transpose(dic.items)
Set dic = Nothing
End Sub``````

Replies
0
Views
204
Replies
3
Views
136
Replies
6
Views
949
Replies
4
Views
177
Replies
3
Views
239

1,216,514
Messages
6,131,105
Members
449,619
Latest member
AntoineMaubon

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