How to filter keywords in VBA, including keywords that may not be found?

Question

I want to filter a report that may or may not have five keywords in Column B (red, blue, orange, green and yellow) These keywords are associated with numbers in a different column

I want to take the sum of the column associated with each keyword on the generated report

However, the report may or may not have all five keywords; day over day may be different, with or without yellow for instance

I took the sum of the first keyword (a criterion) in Column C to paste elsewhere and it works!

But once I search for the second keyword an error occurs : This can't be applied to a single cell, select a single cell in a range (Run-time error 1004) . Any thoughts?

---

Second question is how do set my range (C2:C1000) and (B2:B1000) and for all filtered numbers in column C and keywords in column B, since I can have over 1000 rows or rows whose location is beyond 1000

Set rng = ws.Range("C1:C" & lastrow) 'but to no avail

Sub filterVBA()
    Dim lastrow As Long
    Dim visibleTotal As Long
    Dim ws As Worksheet
    Dim rng As Range

    Set ws = ThisWorkbook.Sheets("Sheet1")
    Set rng = ws.Range("C2:C1000")

    Columns("B:B").Select
    Selection.AutoFilter
    ActiveSheet.Range("B2:B1000").AutoFilter Field:=1, Criteria1:="red"

    visibleTotal = Application.WorksheetFunction.Sum(rng.SpecialCells(xlCellTypeVisible))

    Windows("Book6").Activate
    Range("A1").Value = visibleTotal

    Columns("B:B").Select
    Selection.AutoFilter
    ActiveSheet.Range("B2:B1000").AutoFilter Field:=1, Criteria1:="blue"

    Windows("Book6").Activate
    Range("A2").Value = visibleTotal
End Sub

Answer 1

There are a number of issues here.

1. Use of Select gives unexpected results (the second Filter will be applied to Windows("Book6")). Use Variables to reference the sheets and ranges.
2. Resetting the AutoFilter is fragile, if one doesn't already exists it will actually set a filter. Detect if a Filter exists before clearing it.
3. Clean up range selection.
4. Missing visibleTotal = after second filter

---

Sub filterVBA()
    Dim visibleTotal As Long
    Dim wsTable As Worksheet
    Dim wsReport As Worksheet
    Dim rTable As Range
    Dim rReport As Range

    'Get reference to Table
    Set wsTable = ThisWorkbook.Sheets("Sheet1")
    With wsTable
        Set rTable = .Range("B2", .Cells(.Rows.Count, "C").End(xlUp))
    End With

    'Get Reference to Reult sheet
    Set wsReport = Application.Workbooks("Book6").ActiveSheet
    Set rReport = wsReport.Cells(1, 1)

    'Clear Filter if it exists
    If wsTable.AutoFilterMode Then
        rTable.AutoFilter
    End If
    'Set Filter
    rTable.AutoFilter Field:=1, Criteria1:="red"

    visibleTotal = Application.WorksheetFunction.Sum(rTable.Columns(2).SpecialCells(xlCellTypeVisible))
    'Alternative formula
    'visibleTotal = Application.WorksheetFunction.Subtotal(109, rTable.Columns(2))

    'Report result
    rReport.Value = visibleTotal
    Set rReport = rReport.Offset(1, 0)

    'Next Filter
    rTable.AutoFilter Field:=1, Criteria1:="white"
    visibleTotal = Application.WorksheetFunction.Sum(rTable.Columns(2).SpecialCells(xlCellTypeVisible))

    rReport.Value = visibleTotal
    Set rReport = rReport.Offset(1, 0)
End Sub

_{Note on why there is no Error Handling around SpecialCells}

_{Because the range SpecialCells is applied to includes the header row, and a AutoFilter never hides the header, in this case SpecialCells will always return a result .}