The following code applies filters and selects the top 10 items in column B after some filters are applied to the table. I have been using this for many different filtered selection, but I came across a problem with one of my filter combinations.
I found that when there is only one item in column B after filtering, it doesn't copy that one cell - instead it copies the entire row and seems to be a strange selection.
When I manually add one more item to this filter (total 2), then it copies it fine. Any ideas on why this code won't work when there is only one item?
Sub top10()
Dim r As Range, rC As Range
Dim j As Long
'Drinks top 10
Worksheets("OLD_Master").Columns("A:H").Select
Selection.sort Key1:=Range("H1"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Worksheets("OLD_Master").Range("A:H").AutoFilter Field:=4, Criteria1:=Array( _
"CMI*"), Operator:= _
xlFilterValues
Worksheets("OLD_Master").Range("A:H").AutoFilter Field:=5, Criteria1:="Drinks"
Set r = Nothing
Set rC = Nothing
j = 0
Set r = Range("B2", Range("B" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)
For Each rC In r
j = j + 1
If j = 10 Or j = r.Count Then Exit For
Next rC
Range(r(1), rC).SpecialCells(xlCellTypeVisible).Copy
Worksheets("For Slides").Range("P29").PasteSpecial
Worksheets("OLD_Master").ShowAllData
End Sub
See Question&Answers more detail:os