Deleting Rows in multiple sheets using VBA

[forensic93]

Hi all,

I have a workbook in which i have multiple sheets currently maxed out on line limits.
Deleting the lines manually is taking forever so i wrote a macro which will delete any line in which columns B, C, D, F, G and I have a 0 in them.
I'm getting an issue where the code only goes to the last sheet and deletes every second row meeting that criteria only up to row 400.

Would someone be able to explain why this is happening and possible fix for it?

sheetNumber = 1
rowNumber = 2 ' first row is headings
Counter = 400

For i = 1 To Counter

If (Sheets("Sheet" & sheetNumber).Cells(rowNumber, 2).Value = 0) And (Sheets("Sheet" & sheetNumber).Cells(rowNumber, 3).Value = 0) And (Sheets("Sheet" & sheetNumber).Cells(rowNumber, 4).Value = 0) And (Sheets("Sheet" & sheetNumber).Cells(rowNumber, 5).Value = 0) And (Sheets("Sheet" & sheetNumber).Cells(rowNumber, 6).Value = 0) And (Sheets("Sheet" & sheetNumber).Cells(rowNumber, 7).Value = 0) And (Sheets("Sheet" & sheetNumber).Cells(rowNumber, 8).Value = 0) And (Sheets("Sheet" & sheetNumber).Cells(rowNumber, 9).Value = 0) Then
Rows("rowNumber").EntireRow.Delete

End If

''''''''''''''''''''''''''''''''''''''''''''''
' Change to next sheet
''''''''''''''''''''''''''''''''''''''''''''''

rowNumber =  rowNumber + 1
If rowNumber > 990002 Then
rowNumber = 2
sheetNumber = sheetNumber + 1
End If

Next

 

[Michael M]

How about

Sub MM1()
Dim ws As Worksheet, counter As Long, i As Long
counter = 400
For Each ws In Worksheets
    ws.Activate
    For i = counter To 2 Step -1
        If WorksheetFunction.CountIf(Range("A" & i & ":I" & i), "0") = 9 Then
            Rows(i).Delete
        End If
    Next i
Next ws
End Sub

 

[Peter_SSs]

any line in which columns B, C, D, F, G and I have a 0 in them

This does not correspond to your code line:

If (Sheets("Sheet" & sheetNumber).Cells(rowNumber, 2).Value = 0) And (Sheets("Sheet" & sheetNumber).Cells(rowNumber, 3).Value = 0) And (Sheets("Sheet" & sheetNumber).Cells(rowNumber, 4).Value = 0) And (Sheets("Sheet" & sheetNumber).Cells(rowNumber, 5).Value = 0) And (Sheets("Sheet" & sheetNumber).Cells(rowNumber, 6).Value = 0) And (Sheets("Sheet" & sheetNumber).Cells(rowNumber, 7).Value = 0) And (Sheets("Sheet" & sheetNumber).Cells(rowNumber, 8).Value = 0) And (Sheets("Sheet" & sheetNumber).Cells(rowNumber, 9).Value = 0) Then

Which one is correct?

currently maxed out on line limits.

Will any sheets actually have data in the very last row of the worksheet (row 1,048,576)?

 

[forensic93]

I just ran the code and again it moves to the last sheet and removes every 2nd and 3rd line in a series.
So i'm not sure where the issue is coming from.

 

[forensic93]

This does not correspond to your code line:

If (Sheets("Sheet" & sheetNumber).Cells(rowNumber, 2).Value = 0) And (Sheets("Sheet" & sheetNumber).Cells(rowNumber, 3).Value = 0) And (Sheets("Sheet" & sheetNumber).Cells(rowNumber, 4).Value = 0) And (Sheets("Sheet" & sheetNumber).Cells(rowNumber, 5).Value = 0) And (Sheets("Sheet" & sheetNumber).Cells(rowNumber, 6).Value = 0) And (Sheets("Sheet" & sheetNumber).Cells(rowNumber, 7).Value = 0) And (Sheets("Sheet" & sheetNumber).Cells(rowNumber, 8).Value = 0) And (Sheets("Sheet" & sheetNumber).Cells(rowNumber, 9).Value = 0) Then

Which one is correct?


Will any sheets actually have data in the very last row of the worksheet (row 1,048,576)?

Yes i have updated it to reflect the right columns

And no, i have only imported up to the 990000 row before moving onto a new sheet.

sheetNumber = 1
rowNumber = 2 ' first row is headings
Counter = 400

For i = 1 To Counter

If (Sheets("Sheet" & sheetNumber).Cells(rowNumber, 2).Value = 0) And (Sheets("Sheet" & sheetNumber).Cells(rowNumber, 3).Value = 0) And (Sheets("Sheet" & sheetNumber).Cells(rowNumber, 4).Value = 0)  And (Sheets("Sheet" & sheetNumber).Cells(rowNumber, 6).Value = 0) And (Sheets("Sheet" & sheetNumber).Cells(rowNumber, 7).Value = 0)  And (Sheets("Sheet" & sheetNumber).Cells(rowNumber, 9).Value = 0) Then
Rows("rowNumber").EntireRow.Delete

End If

''''''''''''''''''''''''''''''''''''''''''''''
' Change to next sheet
''''''''''''''''''''''''''''''''''''''''''''''

rowNumber =  rowNumber + 1
If rowNumber > 990002 Then
rowNumber = 2
sheetNumber = sheetNumber + 1
End If

Next

 

[Peter_SSs]

So i'm not sure where the issue is coming from.

The issue is coming from the fact that you are working down the sheet deleting rows. When deleting rows it is easier if your work up the sheet from the bottom.

However, you indicate that your sheets are very large and deleting the rows one at a time could still be quite slow. If I can get the answers to my questions above, I think that I can give you some alternate code that will be much faster.

 

[Peter_SSs]

Yes i have updated it to reflect the right columns

OK, that looks like columns B, C, D, F, G and I

Give this a try in a copy of your workbook.

Sub Del_rows()
  Dim a As Variant, b As Variant
  Dim ws As Worksheet
  Dim nc As Long, lr As Long, i As Long, j As Long, k As Long, uba2 As Long
  
  For Each ws In ThisWorkbook.Worksheets
    k = 0
    With ws
      nc = .Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
      lr = .Range("A" & .Rows.Count).End(xlUp).Row
      a = Application.Index(.Cells, Evaluate("row(2:" & lr & ")"), Array(2, 3, 4, 6, 7, 9))
      uba2 = UBound(a, 2)
      ReDim b(1 To UBound(a), 1 To 1)
      For i = 1 To UBound(a)
        For j = 1 To uba2
          If a(i, j) <> 0 Then Exit For
        Next j
        If j > uba2 Then
          k = k + 1
          b(i, 1) = 1
        End If
      Next i
      If k > 0 Then
        Application.ScreenUpdating = False
        With .Range("A2").Resize(UBound(a), nc)
          .Columns(nc).Value = b
          .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlNo
          .Resize(k).EntireRow.Delete
        End With
        Application.ScreenUpdating = True
      End If
    End With
  Next ws
  MsgBox "Done"
End Sub

 

[forensic93]

The issue is coming from the fact that you are working down the sheet deleting rows. When deleting rows it is easier if your work up the sheet from the bottom.

Oh okay, to answer your questions columns B, C, D, F, G and I is correct and no the data only goes to the 990 000 row on each sheet.

 

[forensic93]

Thank you Peter! That worked perfectly!

 

[Peter_SSs]

Thank you Peter! That worked perfectly!

You're welcome. .. and much quicker I hope.