Macro/VBA - Filter based on cell colour AND cell value

Question

Objective is to filter for rows where

1. Cell colour not equal to RGB(255, 255, 0) AND
2. Cell value not equal to "A"

I have the following code, but it seems to only filter for the first condition:

Sub code()
        ActiveSheet.Range("$A$1:$JI5000").AutoFilter Field:=1, Criteria1:=RGB(255, 255, 0), Operator:=xlFilterCellColor, Criteria2:="<>A"
End Sub

As you can see, I am also struggling to code "not equal to RGB(255, 255, 0)" so I've coded in to show everything that is not highlighted. Could use some help on this as well! Thank you.

Answer 1

Filter by (Not) Color and by (Not) Value

• It is assumed that the table starts in cell A1 (CurrentRegion may fail).
• Adjust the values in the constants section and the worksheet.
• For this to work, you need to have a column (uCol) with unique values in your table. If there is no such column, add one, e.g. one containing numbers 1, 2, 3... rg.rows.count - 1.

Option Explicit

Sub filterByNotColorNotValue()
    
    Const fCol As Long = 1 ' Filter Column (Field)
    Const uCol As Long = 2 ' Unique Column (pick one containing unique values)
    Const fCriteria As String = "A" ' (Not) Filter Criteria
    Dim fColor As Long: fColor = RGB(255, 255, 0) ' (Not) Filter Color
    
    Dim rg As Range
    With ActiveSheet ' With ThisWorkbook.Worksheets("Sheet1")
        If .AutoFilterMode Then
            .AutoFilterMode = False
        End If
        Set rg = .Range("A1").CurrentRegion
    End With
    
    Dim colOffset As Long
    colOffset = rg.Columns(uCol).Column - rg.Columns(fCol).Column
    Dim rCount As Long: rCount = rg.Rows.Count - 1 ' - 1 - no headers
    Dim dat() As String: ReDim dat(0 To rCount - 1) ' - 1 - zero-based
    Dim n As Long: n = -1 ' -1 - zero-based
    
    ' Write unique values (from Unique Column) that meet the criteria
    ' to the array.
    Dim fCell As Range
    For Each fCell In rg.Columns(fCol).Resize(rCount).Offset(1).Cells
        If fCell.Interior.Color <> fColor Then
            If fCell.Value <> fCriteria Then
                n = n + 1
                dat(n) = CStr(fCell.Offset(, colOffset).Value) ' Note CStr
            End If
        End If
    Next fCell
    
    ' Filter Unique Column by the values in the array.
    If n > -1 Then
        ReDim Preserve dat(0 To n)
        rg.AutoFilter uCol, dat, xlFilterValues
    End If
    
End Sub