By way of simplified example, say you have the following dataset:
A B C
Name Group Amount
Dave A 2
Mike B 3
Adam C 4
Charlie A 2
Edward B 5
Fiona B 5
Georgie A 4
Harry C 1
Mary A 0
Delia A 0
Victor B 1
Dennis B 0
Erica A 4
Will B 4
I'm trying to extract the highest 'x' entries (let's say 2 in this example) from each group.
For example, the highest two entries in Group A are Georgie and Erica with 4. I also then want the highest two entries for Group B and C.
I want the VBA code to extract these rows and paste them on another worksheet for subsequent analysis.
I have tried code like this so far:
ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add Key:=Range _
("C1"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveSheet.Range("$A$1:$C$15").AutoFilter Field:=2, Criteria1:="A"
Range("A5:C6").Select
Selection.Copy
Sheets("Sheet2").Select
Range("A2").Select
ActiveSheet.Paste
Sheets("Sheet1").Select
ActiveSheet.Range("$A$1:$C$15").AutoFilter Field:=2, Criteria1:="B"
Range("A2:C3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet2").Select
Range("E2").Select
ActiveSheet.Paste
Sheets("Sheet1").Select
ActiveSheet.Range("$A$1:$C$15").AutoFilter Field:=2, Criteria1:="C"
Range("A4:C11").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet2").Select
Range("I2").Select
ActiveSheet.Paste
In short, I'm just sorting the values from Largest to Smallest, and then filtering for each group, and extracting the top two values. The code is not resilient, however, as the copy part depends on the names being in a particular order, which will change when I get new data.
Is there a cleverer, cleaner way of doing this?
See Question&Answers more detail:os