根据A列中的文本清除特定的单元格范围

Question

I need to clear out specific cell ranges in the rows that have the word "Actual" in column A. I have been experimenting with the following code that works, however it is extremely slow because it needs to process through three IF statements to clear out the discontinuous ranges B:E,I:J,N:O. Does anyone have ideas as how to combine the three if statements into one statement, and/or provide ideas on how to speed up this code? Thank you for your consideration.

Sub ClearWeeklyActualPHSR()
Dim lr As Long, i As Long
'Purpuse: clears specific cell ranges if column A = "Actual"

Application.ScreenUpdating = False                      'Disable screen refresh
Application.Calculation = xlCalculationManual           'Switch calculation mode to manual (speeds up calculation)

'Counts number of rows in column A
lr = Sheets("Actual Data").Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To lr
    'If "Actual" in column A, then clear contents of columns B:E,I:J,N:O for those rows.
    If Sheets("Actual Data").Cells(i, "A") = "Actual" Then Cells(i, "B").Resize(1, 4).ClearContents
    Cells(i, "I").Resize(1, 2).ClearContents
    Cells(i, "N").Resize(1, 2).ClearContents
Next i

Application.ScreenUpdating = True                       'Enable Auto calculation
Application.Calculation = xlCalculationAutomatic        'Switch calculation mode back to auto
End Sub

Answer 1

This is untested , but may serve as a template:

Sub ClearWeeklyActualPHSR()
    Dim lr As Long, i As Long
    'Purpuse: clears specific cell ranges if column A = "Actual" - SUB is SLOW

    Application.ScreenUpdating = False                      'Disable screen refresh
    Application.Calculation = xlCalculationManual           'Switch calculation mode to manual (speeds up calculation)

    'Counts number of rows in column A
    With Sheets("Actual Data")
        lr = .Cells(Rows.Count, "A").End(xlUp).Row
        For i = 2 To lr
            'If "Actual" in column A, then clear contents of columns B:E,I:J,N:O for those rows.
            If .Cells(i, "A") = "Actual" Then
                Union(.Cells(i, "B").Resize(1, 4), .Cells(i, "I").Resize(1, 2), .Cells(i, "N").Resize(1, 2)).ClearContents
            End If
        Next i
    End With

    Application.ScreenUpdating = True                       'Enable Auto calculation
    Application.Calculation = xlCalculationAutomatic        'Switch calculation mode back to auto
End Sub