Deleting "empty" rows when they just "appear empty"

Question

I can not manage to cleanse my data of the "empty" rows. There is no problem in deleting the "0" but those cells which are empty are not empty but have something like "null strings" in it.

Sub Reinigung()

Application.ScreenUpdating = False 
Application.EnableEvents = False 

ListeEnde3 = ThisWorkbook.Sheets("input").Cells(Rows.Count, 1).End(xlUp).Row
For Zeile1 = 2 To ListeEnde3

        If ThisWorkbook.Sheets("input").Cells(Zeile1, 14) = "0" Or ThisWorkbook.Sheets("2018").Cells(Zeile1, 14) = "" Then
        ThisWorkbook.Sheets("input").Rows(Zeile1).Delete
        Zeile1 = Zeile1 - 1
        Else
        End If

Next

' ThisWorkbook.Sheets("import").Columns(14).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub

That code just freezes my excel, if i leave out the thisWorkbook.Sheets("2018").Cells(Zeile1, 14) = "" part, it works and deletes all rows, where colum 14 contains a "0".

If I check the cells which appear blank with =isblank it returns "false". There is no "space" in the cell and no " ' ".

What to do?

edit

After the first tips my code looks like this now:

Sub Reinigung()

Dim ListeEnde3 As Long
Dim Zeile1 As Long

Application.ScreenUpdating = False 
Application.EnableEvents = False 

ListeEnde3 = ThisWorkbook.Sheets("import").Cells(Rows.Count, 1).End(xlUp).Row
For Zeile1 = ListeEnde3 To 2 Step -1
    Set rngX = ThisWorkbook.Sheets("import").Cells(Zeile1, 14)
    If (rngX = "0" Or rngX = "") Then  'or rngY = vbNullString
        ThisWorkbook.Sheets("import").Rows(Zeile1).Delete
    End If
Next Zeile1

' ThisWorkbook.Sheets("import").Columns(14).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub

Excel still crashes / freezes (I waited for 5 minutes) but since the code runs "smoothly" with F8 I wanted to give it a shot with less data: It works!

If I am not reducing the data there are ~ 70000 rows to check. I let it run on 720 rows and it worked.

Any way to tweak the code in a way that it can handle the 70000+ rows? I didn't think that it would be too much.

Thanks!

Answer 1

You can use AutoFilter and delete the visible rows (not tested) :

Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("import")
ws.UsedRange.AutoFilter 14, Array("=0", "="), xlFilterValues
ws.UsedRange.Offset(1).EntireRow.Delete
ws.AutoFilterMode = False

Answer 2

Another way is to simply use internal arrays and write out the new data set which has valid rows.

It is very fast.

If your dataset has formulas then you'll have to use extra code, but if it's constants only, then the below should do:

Sub Reinigung()
  'Here I test with column E to Z, set Ranges appropriately
  Application.ScreenUpdating = False
  Application.EnableEvents = False

  Dim ListeEnde3 As Long, x As Long, y As Long
  'last row of data - set to column of non-blank data
  ListeEnde3 = ThisWorkbook.Sheets("import").Cells(Rows.Count, 5).End(xlUp).Row

  Dim ws As Worksheet
  Set ws = ThisWorkbook.Sheets("import")

  Dim startCell As Range
  'set to whatever cell is the upper left corner of data
  Set startCell = ThisWorkbook.Sheets("import").Range("E1")

  Dim arr As Variant, arrToPrint() As Variant
  'Get rightmost column of data instead of hardcoding to "Z"
  'write dataset into an array
  arr = ws.Range(startCell, ws.Range("Z" & ListeEnde3)).Value
  x = UBound(arr) - LBound(arr) + 1         'num of rows of data
  y = UBound(arr, 2) - LBound(arr, 2) + 1   'num of columns of data

  ReDim arrToPrint(1 To x, 1 To y) 'array to hold valid/undeleted data

  Dim i As Long, j As Long, printCounter As Long, arrayColumnToCheck as Long
  arrayColumnToCheck = 14 - startCell.Column + 1   '14 is column N
  For i = 1 To x          
        If arr(i, arrayColumnToCheck ) <> 0 And arr(i, arrayColumnToCheck ) <> vbNullString Then
              printCounter = printCounter + 1
              For j = 1 To y
                    'put rows to keep in arrToPrint
                    arrToPrint(printCounter, j) = arr(i, j)
              Next j
        End If
  Next i
  'Print valid rows to keep - only values will print - no formulas
  startCell.Resize(printCounter, y).Value = arrToPrint
  'Delete the rows with zero & empty cells off the sheet
  startCell.Offset(printCounter).Resize(ListeEnde3 - printCounter, y).Delete xlShiftUp

  Application.ScreenUpdating = True
  Application.EnableEvents = True

End Sub

Answer 3

NEVER a good idea to alter a loop counter: Zeile1 = Zeile1 - 1

Instead start at the end and use Step -1 in your loop to work backward. You are in a infinite loop because the loop doesnt move forward. If Zeile=3 and there is a "" in row3 in the '2018' sheet, then it will always be stuck on the Zeile1 = 3 line. You will always be coming back to that "" on row 3 in '2018'sheet.

For Zeile1 = ListeEnde3 To 2 Step -1
    Set rngX = ThisWorkbook.Sheets("input").Cells(Zeile1, 14)
    Set rngY = ThisWorkbook.Sheets("2018").Cells(Zeile1, 14)
    If (rngX = "0" Or rngY = "") Then  'or rngY = vbNullString
        ThisWorkbook.Sheets("input").Rows(Zeile1).Delete
    End If
Next Zeile1

Answer 4

You can add IsEmpty to your code to check the cells filling

Sub Reinigung()

Application.ScreenUpdating = False
Application.EnableEvents = False

ListeEnde3 = ThisWorkbook.Sheets("input").Cells(Rows.Count, 1).End(xlUp).Row
For Zeile1 = 2 To ListeEnde3
    Set rngX = ThisWorkbook.Sheets("input").Cells(Zeile1, 14)
    Set rngY = ThisWorkbook.Sheets("2018").Cells(Zeile1, 14)
    If (rngX = "0" And (Not IsEmpty(rngX))) Or (rngY = "") Then
        ThisWorkbook.Sheets("input").Rows(Zeile1).Delete
        Zeile1 = Zeile1 - 1
    End If
Next

' ThisWorkbook.Sheets("import").Columns(14).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub