VBA selecting visible cells after filtering

Question

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

Solution

Rory helpfully points out:

If you apply Specialcells to only one cell, it actually applies to the entire used range of the sheet.

Now we know what the problem is, we can avoid it! The line of code where you use SpecialCells:

Set r = Range("B2", Range("B" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)

Instead, set the range first, test if it only contains one cell, then proceed...

Set r = Range("B2", Range("B" & Rows.Count).End(xlUp))
' Check if r is only 1 cell
If r.Count = 1 Then
    r.Copy
Else ' Your previous code
    Set r = r.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
End If

Note, you're assuming there is even one row still visible. It might be that the .End(xlUp) selects row 1 if there is no visible data, you may want to check which row this is first too!

---

Aside: You really should be fully qualifying your ranges, i.e. instead of

 Set r = Range("B2")

You should use

Set r = ThisWorkbook.Sheets("MySheet").Range("B2")

This will save you some confusing errors in future. There are shortcuts you can take, for example saving repetition using With blocks or declaring sheet objects.

' using With blocks
With ThisWorkbook.Sheets("MySheet")
    Set r = .Range("B2")
    Set s = .Range("B3")
    ' ...
End With

' Using sheet objects
Dim sh as Worksheet
Set sh = ThisWorkbook.Sheets("MySheet")
Set r = sh.Range("B2")