Delete blank rows other than first column - excel

Question

I have written a macro to delete the row if it is a blank row or if in column B the cell contains the string XYZ. However, this macro can take a couple minutes to run if there is 200+ rows of data. Can anyone provide anything more efficient in VBA format?
Sub DeleteBlanks()
Dim lr As Long, r As Long
For r = Cells(Rows.Count, "B").End(xlUp).Row To 1 Step -1
Range("B" & r).Replace "*XYZ*", "", xlWhole
If Range("B" & r).Value = "" Then
Range("B" & r & ":Q" & r).Delete (xlShiftUp)
End If
Next r
Application.ScreenUpdating = False
End Sub

Answer 1

I would add the ScreenUpdating line to the top, and also turn calculation to manual:
Sub DeleteBlanks()
Dim lr As Long, r As Long
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For r = Cells(Rows.Count, "B").End(xlUp).Row To 1 Step -1
Range("B" & r).Replace "*XYZ*", "", xlWhole
If Range("B" & r).Value = "" Then
Range("B" & r & ":Q" & r).Delete (xlShiftUp)
End If
Next r
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
As you have it, the entire macro runs, then the screenUpdating is turned off. You can speed it up by putting that up front, then turning it back on when the macro is finished.

Answer 2

In addition to what #BruceWayne said, I will shorten the code
Range("B" & r).Replace "*XYZ*", "", xlWhole
If Range("B" & r).Value = "" Then
With
If Range("B" & r).Value = "" Or InStr(1, Range("B" & r).Value, "XYZ") > 0 then
That will lower the actions that the code needs to make.

Answer 3

First of all, the screen updating should be disabled before the proccess, and re-enabled after that, so the screen will not flash, and load of resources will not be high.
Other than that, text replacement is completely unneeded in your case.
By reading your current code, I assume you consider a blank row if it's empty on column B.
Try this:
Sub DeleteBlanks()
Application.ScreenUpdating = False
Dim lr As Long, r As Long
For r = Cells(Rows.Count, "B").End(xlUp).Row To 1 Step -1
If Range("B" & r).Value = "" Or Range("B" & r).Value Like "*XYZ*" Then
Range("B" & r & ":Q" & r).Delete (xlShiftUp)
End If
Next r
Application.ScreenUpdating = True
End Sub

Answer 4

This solution should be virtually instantaneous:
Public Sub Colin_H()
Dim v, rCrit As Range, rData As Range
With [a1]
Set rData = .Resize(.Item(.Parent.Rows.Count).End(xlUp).Row, .Item(, .Parent.Columns.Count).End(xlToLeft).Column)
End With
Set rCrit = rData.Resize(2, 2).Offset(, rData.Columns.Count + 1)
rCrit.Resize(1) = rData(1, 2): rCrit(2, 1) = "*": rCrit(2, 2) = "<>*xyz*"
rData.AdvancedFilter xlFilterCopy, rCrit, rCrit.Resize(1, 1).Offset(, 2)
With rCrit.Resize(1, 1).Offset(, 2).Resize(rData.Rows.Count, rData.Columns.Count)
v = .Value2
rData = v
.ClearContents
rCrit.ClearContents
End With
End Sub
Notice that there is no looping, no row shifting, and no iterated range construction.
This uses the advanced filter of the range object to filter your records in one quick blast to a range adjacent to your source data. The result is then copied over the source without using the clipboard. There is no quicker or more efficient way to achieve your objective.