How do I remove rows that don't have any values ( using Excel VBA )? - vba

Question

I am working on an Excel VBA Script to clean up a spreadsheet (first I remove lines with blanks, then I find/replace some text to be more summarized).
I would like to remove rows where the respondent did not answer any survey questions. The row does contain some data in the first few columns (A, B, C), such as their IP address , etc. The survey answers are located in column Q3 until column AC ( $Q4 to $AC) Here is screenshot :
But if user did not answer any survey question, I want to delete that row.
My VBA script is here :
Sub Main()
ReplaceBlanks
Multi_FindReplace
End Sub
Sub ReplaceBlanks()
On Error Resume Next
Worksheet.Columns("$Q:$AC").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
End Sub
Sub Multi_FindReplace() 'PURPOSE: Find & Replace a list of text/values throughout entire workbook 'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault
Dim sht As Worksheet Dim fndList As Variant
Dim rplcList As Variant Dim x As Long
fndList = Array("Mostly satisfied", "Completely satisfied", "Not at all satisfied")
rplcList = Array("satisfied", "satisfied", "unsatisfied")
'Loop through each item in Array lists
For x = LBound(fndList) To UBound(fndList)
'Loop through each worksheet in ActiveWorkbook
For Each sht In ActiveWorkbook.Worksheets
sht.Cells.Replace What:=fndList(x), Replacement:=rplcList(x), _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
Next sht
Next x
End Sub
When I run this without the error-handling in the ReplaceBlanks subroutine, I obtain this error message :
Run-time error '424': Object required
So far, only the second subroutine works (i.e Multi_FindReplace ). How do I fix the first subroutine, so that it removes the rows that don't have respondent answers ?

Answer 1

Replace this line,
Worksheet.Columns("$Q:$AC").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
With this,
Columns("$Q:$AC").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Either state the sheet you want to delete from by setting it or just start with Columns
The error you are getting is due to it not recognignising Worksheet you have before Columns("$Q:$AC")
You could do this if you need to specify the sheet you are deleteing from.
Dim ws As Worksheet
Set ws = Sheets("Sheet1")
ws.Columns("$Q:$AC").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Or even this
ActiveSheet.Columns("$Q:$AC").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
And as per comments, if you have multiple blanks cells you will throw an error, so if you have multiple blanks cells in one row and any cell that is blank determins the entire row to be deleted this code should do it for you.
Dim ws As Worksheet
Dim lastrow As Long
Dim rng As Range
Set ws = Sheets("Sheet1")
lastrow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
For i = 2 To lastrow
If WorksheetFunction.CountA(ws.Range(ws.Cells(i, 17), ws.Cells(i, 21))) = 0 Then
If Not rng Is Nothing Then
Set rng = Union(ws.Cells(i, 1), rng)
Else
Set rng = ws.Cells(i, 1)
End If
End If
Next i
rng.EntireRow.Delete

Answer 2

My lazy way is usually to hide the non-blank rows, and delete the visible ones (not tested):
Cells.SpecialCells(xlCellTypeConstants).EntireRow.Hidden = True
Cells.SpecialCells(xlCellTypeVisible).EntireRow.Delete
Cells.EntireRow.Hidden = False