如果单元格包含特定文本，则清除范围的内容

Question

I want to make a macro that clears the content of the cells in the blue border (~40.000 Rows) when the cells in the red border (column AX) contain the text "NoBO" (=No Backorder) without losing the formulas in the columns AP:AX.

Sub clear_ranges()
Dim ws As Worksheet
Dim x As Integer
Dim clearRng As Range

Application.ScreenUpdating = False

Set ws = ThisWorkbook.Sheets("Input")

For x = 6 To ws.Range("B" & Rows.Count).End(xlUp).Row
    If (ws.Range("AX6" & x).Value = "NoBO") Then
        If clearRng Is Nothing Then
            Set clearRng = ws.Range("B6" & x & ":" & "AN6" & x)
        Else
            Set clearRng = Application.Union(clearRng, ws.Range("B6" & x & ":" & "AN6" & x))
        End If
    End If
Next x
clearRng.Clear
End Sub

And for some reason:

For x = 6 To ws.Range("B" & Rows.Count).End(xlUp).Row

gives me a error "Overflow". After searching I know what this error means but I can't find a solution for this.

tl;dr - I want to delete the range B6:B##### (till last row) to AN6:AN####*(till last row) if cell AX##### containts NoBO

Answer 1

It is too easy to get an overflow using Integer . Replace:

Dim x As Integer 

with:

Dim x As Long

Answer 2

Try:

Sub clear_ranges() 

Dim ws As Worksheet 
Dim x As Integer 
Dim clearRng As Range

Application.ScreenUpdating = False

Set ws = ThisWorkbook.Sheets("Input")

For x = 6 To ws.Range("B" & Rows.Count).End(xlUp).Row
    If ws.Range("AX" & x).Value = "NoBO" Then
        ws.Range("B" & x & ":" & "AN" & x).Clear
    End If
Next x

Application.ScreenUpdating = True

End Sub

I think the Union function can only store up to 30 ranges so it might not suit your needs.

Answer 3

Hi if you are Deleting Rows it's the Best to use a For Each Loop or start from the bottom of the column and work up.

'Loop through cells A6:Axxx and delete cells that contain an "x."
   For Each c In Range("AX6:A" & ws.Range("B" & Rows.Count).End(xlUp).Row)
       If c.Value2 = "NoBo" Then

             Set clearRng = ws.Range("B" & c.Row & ":" & "AN" & c.Row)

       End If
       clearRng.Clear
   Next    

Answer 4

try this

Option Explicit

Sub clear_ranges()
Dim ws As Worksheet

Application.ScreenUpdating = False
Set ws = ThisWorkbook.Sheets("Input")
With ws
    With .Range("B5:AX" & .Cells(.Rows.Count, "B").End(xlUp).Row) 'take all data
        .AutoFilter Field:=49, Criteria1:="NoBO" 'filter to keep only rows with "NoBO" in column "AX" (which is the 49th column from column "B"
        With .Offset(1).Resize(.Rows.Count - 1) 'offset from headers
            If Application.WorksheetFunction.Subtotal(103, .Columns(1)) > 0 Then Intersect(.SpecialCells(xlCellTypeVisible), ws.Columns("B:AN")).ClearContents 'clear cells in columns "B:AN" of filtered rows
        End With
        .AutoFilter 'remove autofilter
    End With
End With

Application.ScreenUpdating = True
End Sub

Answer 5

You can try

Assuming that there are no blank cells in AX Column

Sub clr_cell()

For i = 6 To ActiveSheet.Range("AX6", ActiveSheet.Range("AX6").End(xlDown)).Rows.Count
'counts the no. of rows in AX and loops through all

If ActiveSheet.Cells(i, 50).Value = "NoBo" Then

ActiveSheet.Range(Cells(i, 2), Cells(i, 40)).ClearContents
'clears range B to AN

End If

Next i

End Sub

I tested this on 40k rows and it worked fine. It takes a while to execute due to the no. of rows maybe.