(Solved) – Couldn’t Find Assign Index Color Except 40,6

(solved)-–-couldn’t-find-assign-index-color-except-40,6

I have a Macro to delete contents based on the cell color I choose and it only works in a table and color set within the header. I tried several colors but only index color 40 and 6 work. The error is “Run-time error ’91’ Object variable or With block variable not set”.

Can anyone tell what’s the difference? Thank you in advance.

Option Explicit
Sub Column_Clear()
Dim LastRow As Long
Dim LastColumn As Long
Dim ws As Worksheet
Dim oList As ListObject
Dim ColorFound As Variant
Dim CopyAndPasteColumnColor As Variant
Dim StartCopyAndPasteCell As String
Dim cell As Range

''' Adjusting if needed
CopyAndPasteColumnColor = 50
Application.FindFormat.Clear 'Ensure Find Formatting Rule is Reset
For Each ws In Worksheets
ws.Activate ' Go to this sheet
For Each oList In ws.ListObjects
    For Each cell In oList.HeaderRowRange ' Searching cells within first row
        Set oList = ws.ListObjects(oList.Name)
        oList.AutoFilter.ShowAllData ' Take out filter
        Application.FindFormat.Interior.colorIndex = CopyAndPasteColumnColor ' Store active cell's fill color into "Find"

        If cell.Interior.colorIndex = CopyAndPasteColumnColor Then
            ColorFound = oList.HeaderRowRange.Find("", , , , , , , , True).Address(False, False) ' Find the address based on the cell color as you want
            StartCopyAndPasteCell = ws.Range("" & ColorFound & "").Offset(1, 0).Address
            LastRow = ws.Cells(ws.Rows.count, "A").End(xlUp).Row
            LastColumn = ws.Range("" & ColorFound & "").Column
            ws.Range(StartCopyAndPasteCell & ":" & Col_Letter(LastColumn) & LastRow).ClearContents ' Clear contents based on the color
            ws.Range(StartCopyAndPasteCell & ":" & Col_Letter(LastColumn) & LastRow).Select

            Debug.Print "Table name:                " & oList.Name
            Debug.Print "Color Found:               " & ColorFound
            Debug.Print "Start Copy and Paste Cell: " & StartCopyAndPasteCell
            Debug.Print "End Copy and Paste Cell:   " & Col_Letter(LastColumn) & LastRow
            Debug.Print vbNewLine
            Application.FindFormat.Clear 'Ensure Find Formatting Rule is Reset
        Else
               'Nothing
        End If
    Next cell
Next oList
Next ws
End Sub


Public Function Col_Letter(lngCol As Long) As String
    Dim vArr
    vArr = Split(Cells(1, lngCol).Address(True, False), "$")
    Col_Letter = vArr(0)
End Function

Leave a Reply

Your email address will not be published. Required fields are marked *