1

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 :

enter image description here

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 ?

A.S.H
  • 29,101
  • 5
  • 23
  • 50
Caffeinated
  • 11,982
  • 40
  • 122
  • 216
  • duplicate of http://stackoverflow.com/questions/7876340/deleting-empty-rows-in-excel-using-vba – aggaton Jan 04 '17 at 21:57
  • 3
    Why is this all one line? `On Error Resume Next Worksheet.Columns("$Q:$AC").SpecialCells(xlCellTypeBlanks).EntireRow.Delete On Error GoTo 0`? That should be three lines. `On Error Resume Next` // `Worksheet.Columns("$Q:$AC").SpecialCells(xlCellTypeBlanks).EntireRow.Delete` // `On Error GoTo 0` ...also, take the `On Error`s out, and see what error you get, that may be hindering the deleting. – BruceWayne Jan 04 '17 at 22:04
  • @BruceWayne - thanks, fixed this. Ok I will try that out – Caffeinated Jan 04 '17 at 22:09
  • @BruceWayne - when I take those lines out I get this - `Run-time error '424': Object required ` .. not sure what is meant by 424. – Caffeinated Jan 04 '17 at 22:10
  • 1
    `Worksheet.Columns(` is where you get the error? You mean `ActiveSheet`? – PatricK Jan 04 '17 at 22:13
  • @PatricK - not sure what this means. What is `ActiveSheet` ? – Caffeinated Jan 04 '17 at 22:14
  • @PatricK - ah Ok , I think I see what you mean. I will try this, thanks ! – Caffeinated Jan 04 '17 at 22:19

2 Answers2

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
KyloRen
  • 2,691
  • 5
  • 29
  • 59
0

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
Slai
  • 22,144
  • 5
  • 45
  • 53