CODEWITHSUNDEEP
excelvba
TLDAN
TLDAN

Reputation: 53

Delete all cells in a sheet based on interior color

Range("A:A").Select
For Each Cell In Selection
    If ActiveCell.Interior.Color = Excel.XlRgbColor.rgbOrange Then
        cell.clear
    End If
Next

Upvotes: 1

Views: 5461

Answers (2)

brettdj
brettdj

Reputation: 55682

This code uses Find to quickly clear cells matching your desired format

The line to update for other cell fromats is:
.FindFormat.Interior.Color = Excel.XlRgbColor.rgbOrange

Option Explicit
Sub FastFind()
    Dim rng1 As Range
    Dim rng2 As Range
    Dim cel1 As Range
    Dim strFirstAddress As String
    Dim lAppCalc As Long

    'Get working range from user
    On Error Resume Next
    Set rng1 = Application.InputBox("Please select range to search for ", "User range selection", Selection.Address(0, 0), , , , , 8)
    On Error GoTo 0
    If rng1 Is Nothing Then Exit Sub

    With Application
        lAppCalc = .Calculation
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .FindFormat.Interior.Color = Excel.XlRgbColor.rgbOrange
    End With

    Set cel1 = rng1.Find("", , xlValues, xlPart, xlByRows, , , , True)
    If Not cel1 Is Nothing Then
        Set rng2 = cel1
        strFirstAddress = cel1.Address
        Do
            Set cel1 = rng1.Find("", cel1, xlValues, xlPart, xlByRows, , , , True)
            Set rng2 = Union(rng2, cel1)
        Loop While strFirstAddress <> cel1.Address
    End If

    If Not rng2 Is Nothing Then rng2.Clear

    With Application
        .ScreenUpdating = True
        .Calculation = lAppCalc
    End With
End Sub

Upvotes: 1

assylias
assylias

Reputation: 328598

This should work better (in your code you were always checking the active cell):

Range("A:A").Select
For Each Cell In Selection
    If cell.Interior.Color = Excel.XlRgbColor.rgbOrange Then
        cell.clear
    End If
Next

And you don't need to select the range so you could also write:

For Each Cell In Range("A:A")
    If cell.Interior.Color = Excel.XlRgbColor.rgbOrange Then
        cell.clear
    End If
Next

Upvotes: 1

Related Questions