Find maximum given a certain value in another column

[Agamemnon]

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

 

[venkat1926]

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
	A	B	C	D
1	Rep1	10
2	Rep2	20
3	Rep2	25
4	Rep3	55
5	Rep3	45
6	Rep4	7
7	Rep4	8
8	Rep4	4
9
10
11
12
13	Rep1	10
14	Rep2	25
15	Rep3	55
16	Rep4	8
Sheet1

 

[Domenic]

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!

 

[Agamemnon]

Thx for your answers. It works perfectly with these formulas.
But does anyone have idea how to translate this procedure into VBA Code.

Aga

 

[Agamemnon]

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

 

[venkat1926]

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

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
'msgbox rng.Address
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))
'msgbox rng1.Address
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
	A	B	C	D	E
1	h1	h2		h1	max
2	Rep1	10		Rep1	10
3	Rep2	20		Rep2	25
4	Rep2	25		Rep3	55
5	Rep3	55		Rep4	8
6	Rep3	45		rept5	14
7	Rep4	7		rept6	5
8	Rep4	8
9	Rep4	4
10	rept5	14
11	rept5	1
12	rept5	2
13	rept5	4
14	rept6	5
15
Sheet1

 

[jindon]

Hi
No sort required

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
         dic.add a(i,1), a(i,2)
      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