VBA - match criteria then delete specific cells (not entire rows!)

[keresztesi]

Hi,

I'd like to have a vba code for that problem.

If column "R" contains whether "xxx" or "yyy" or "zzz" then delete from the specific rows thw following cells: U:AD and AV:BE and BW:CF and CX:DG.

So, for example in column "R" it finds "xxx" in row number 15 and "yyy" in row number 22, than it clears the following cells:
U15:AD15 and U22:AD22
AV15:BE15 and AV22:BE22
BW15:CF15 and BW22:CF22
CX15:DG15 and CX22:DG22

Thx

 

[wideboydixon]

Public Sub ClearSomeCells()

Dim lastRow As Long
Dim thisRow As Long

lastRow = Cells(Rows.Count, "R").End(xlUp).Row
For thisRow = 1 To lastRow
    Select Case Cells(thisRow, "R")
        Case "xxx", "yyy", "zzz"
            With Cells(thisRow, "A")
                .Range("U1:AD1").ClearContents
                .Range("AV1:BE1").ClearContents
                .Range("BW1:CF1").ClearContents
                .Range("CX1:DG1").ClearContents
            End With
    End Select
Next thisRow

End Sub

WBD

 

[keresztesi]

Thx, it works although it takes a lot of time (more then 5 minutes!)
Is there a way to "speed it up"?

Thx

Public Sub ClearSomeCells()

Dim lastRow As Long
Dim thisRow As Long

lastRow = Cells(Rows.Count, "R").End(xlUp).Row
For thisRow = 1 To lastRow
    Select Case Cells(thisRow, "R")
        Case "xxx", "yyy", "zzz"
            With Cells(thisRow, "A")
                .Range("U1:AD1").ClearContents
                .Range("AV1:BE1").ClearContents
                .Range("BW1:CF1").ClearContents
                .Range("CX1:DG1").ClearContents
            End With
    End Select
Next thisRow

End Sub

WBD

 

[wideboydixon]

You could try to suppress screen updating:

Public Sub ClearSomeCells()

Dim lastRow As Long
Dim thisRow As Long

Application.ScreenUpdating = False

lastRow = Cells(Rows.Count, "R").End(xlUp).Row
For thisRow = 1 To lastRow
    Select Case Cells(thisRow, "R")
        Case "xxx", "yyy", "zzz"
            With Cells(thisRow, "A")
                .Range("U1:AD1").ClearContents
                .Range("AV1:BE1").ClearContents
                .Range("BW1:CF1").ClearContents
                .Range("CX1:DG1").ClearContents
            End With
    End Select
Next thisRow

Application.ScreenUpdating = True

End Sub

 

[keresztesi]

Unfortunately it didn't become faster!

It is maybe because my excel file is full with huge functions.
Maybe it recalculates everything cell by cell?

 

[keresztesi]

Any ideas?
Any other solutions?

 

[wideboydixon]

I haven't tested this extensively but perhaps filtering would work for you instead:

Public Sub ClearSomeCells()

Dim lastRow As Long

lastRow = Cells(Rows.Count, "R").End(xlUp).Row
With Range("A1:DG" & lastRow)
    .AutoFilter Field:=18, Criteria1:=Array("xxx", "yyy", "zzz"), Operator:=xlFilterValues
    .SpecialCells(xlCellTypeVisible).Range("U:AD").ClearContents
    .SpecialCells(xlCellTypeVisible).Range("AV:BE").ClearContents
    .SpecialCells(xlCellTypeVisible).Range("BW:CF").ClearContents
    .SpecialCells(xlCellTypeVisible).Range("CX:DG").ClearContents
    .AutoFilter
End With

End Sub

WBD

 

[keresztesi]

I tested it, but it gave me an error for this line:
.AutoFilter Field:=18, Criteria1:=Array("5.régi", "4.lejárt"), Operator:=xlFilterValues

Instead "xxx", "yyy" a used other criterias.

I haven't tested this extensively but perhaps filtering would work for you instead:

Public Sub ClearSomeCells()

Dim lastRow As Long

lastRow = Cells(Rows.Count, "R").End(xlUp).Row
With Range("A1:DG" & lastRow)
    .AutoFilter Field:=18, Criteria1:=Array("xxx", "yyy", "zzz"), Operator:=xlFilterValues
    .SpecialCells(xlCellTypeVisible).Range("U:AD").ClearContents
    .SpecialCells(xlCellTypeVisible).Range("AV:BE").ClearContents
    .SpecialCells(xlCellTypeVisible).Range("BW:CF").ClearContents
    .SpecialCells(xlCellTypeVisible).Range("CX:DG").ClearContents
    .AutoFilter
End With

End Sub

WBD

 

[GiorgiPepe]

add these two lines in code in top and before ending:
application.calculation = xlmanual <<< top
application.calculation = xlautomatic<<< before end sub

 

[keresztesi]

It looks like this:
Public Sub ClearSomeCells()


Dim lastRow As Long
Application.Calculation = xlManual


lastRow = Cells(Rows.Count, "R").End(xlUp).Row
With Range("A1:DG" & lastRow)
.AutoFilter Field:=18, Criteria1:=("5.régi", "4.lejárt"), Operator:=xlFilterValues
.SpecialCells(xlCellTypeVisible).Range("U:AD").ClearContents
.SpecialCells(xlCellTypeVisible).Range("AV:BE").ClearContents
.SpecialCells(xlCellTypeVisible).Range("BW:CF").ClearContents
.SpecialCells(xlCellTypeVisible).Range("CX:DG").ClearContents
.AutoFilter
End With
Application.Calculation = xlAutomatic


End Sub

But it still gives an error message: "Syntax error" for that line:
.AutoFilter Field:=18, Criteria1:=("5.régi", "4.lejárt"), Operator:=xlFilterValues

add these two lines in code in top and before ending:
application.calculation = xlmanual <<< top
application.calculation = xlautomatic<<< before end sub