Clear content in multiple columns based on cell color

[argld]

Hi
I want to clear content of cells in certain row if interior cell color is different than red. Columns I want to clear are C, D, F, H, J, K, L, M (not all).
I wrote below code and it works, but with bigger sheets it's quite slow and I'm looking for more efficient way for doing this.

Sub clear_cont()
 
Dim x, y As Integer
 
 y = ActiveSheet.UsedRange.Rows.count
 For x = 2 To y
 If Cells(x, 1).Interior.Color <> RGB(255, 0, 0) Then 
    Cells(x, 3).ClearContents
    Cells(x, 4).ClearContents
    Cells(x, 6).ClearContents 
    Cells(x, 8).ClearContents
    Cells(x, 10).ClearContents
    Cells(x, 11).ClearContents
    Cells(x, 12).ClearContents
    Cells(x, 13).ClearContents
 
 End If
Next x
End Sub

 

[Micron]

Don't use UsedRange to find the last row or column with data, because that will return all rows/columns that have had formats applied. You might be looping over tens of thousands more rows than you realize. To find the last row in column A with data:
Range("A" & Rows.count).End(xlUp).Row
or
Cells(Rows.count, "A").End(xlUp).Row
You could put a break point on the For line and see what the value of y is if you want to see if that's your problem.

Could also use a loop rather than a bunch of If's (but you'd need an array since the column number has no pattern). Surely not part of your problem, but if you intended that x is an integer, it is not. It is a variant because it is not explicitly declared.

 

[kevin9999]

The way I read your post is that, for every cell in column A (from row 2 down) that doesn't have an interior colour of red - you want to clear the contents on that row in columns C, D, F, H, J, K, L and M only? If that's the case, and your main concern is the time it takes to do that on a large data set, then the code below might help. It is not

more efficient

in terms of the amount of code, however, I did test it on 25K rows (with 2,200 cells in column A that were red interior) and it cleared the desired cells in under 0.6 seconds. Try it out and let me know how you go. Change the sheet name to suit.

Option Explicit
Sub Clear_If_Not_Red()
    Dim t As Double: t = Timer
    Application.ScreenUpdating = 0
    Application.Calculation = xlManual
    
    Dim ws As Worksheet
    Set ws = Worksheets("Sheet1")   '<<< change to actual sheet name
    Dim LRow As Long
    LRow = ws.Cells(Rows.Count, 1).End(3).Row
    Dim LCol As Long, i As Long, n As Long
    LCol = Cells.Find("*", , xlFormulas, , 2, 2).Column + 1
    
    With ws.Cells(2, LCol).Resize(LRow - 1)
        .Value = Evaluate("row(" & .Address & ")")
    End With
    
    ws.Sort.SortFields.Clear
    ws.Sort.SortFields.Add(Range("A2:A" & LRow), 1, 2, , 0).SortOnValue.Color = RGB(255, 0, 0)
    With ws.Sort
        .SetRange ws.Cells(1, 1).CurrentRegion
        .Header = xlYes
        .Apply
    End With
    
    For i = 2 To LRow
        If ws.Cells(i, 1).Interior.Color = RGB(255, 0, 0) Then
            n = i - 1
            Exit For
        End If
    Next i
    
    Dim Rng As Range
    Set Rng = Intersect(ws.Range("A2:M" & n), ws.Range("C:D,F:F,H:H,J:M"))
    Rng.ClearContents
    
    With ws.Cells(1, 1).CurrentRegion
        .Sort Key1:=ws.Cells(2, LCol), order1:=1, Header:=1
    End With
    ws.Cells(1, LCol).EntireColumn.ClearContents
    
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = 1
    MsgBox "Cleared in " & Timer - t & " seconds"
End Sub