Unable to delete an entire row using VBA :-/

[Richard1982]

Hello everyone!

I have a problem that has me pulling my hair out. I have a spreadsheet with some buttons, when you click the buttons various reports are emailed off to various people. The email is made perfectly, and the file is attached ready to go, except there are two niggles. First the attachment has two shapes that need to be deleted. They are the rounded rectangles you see below. The other niggle is that the spreadsheet is basically a big table and some of the values are 0 (in column D). The data starts on row 6 which is why I have specified that the variable 'r2' starts at 6. I wanted to deleted the rows that have these zero values but for some reason I just get an error. I can change the values to "zero" so it's not a problem manipulating the file, it just isn't happy with me deleting rows for some reason. It's a work file, so I'm unable to share the whole things for confidentiality reasons. Any help would be greatly appreciated

Richard

        'Create the workbook
        Worksheets("1M").Copy
        

        With ActiveWorkbook
   
        Worksheets("1M").Shapes("RoundedRectangle1").Delete
        Worksheets("1M").Shapes("RoundedRectangle2").Delete
        
'      This loop checks if the difference is zero and if so, deletes the line. Except it is unable to delete the line for some reason I am yet to determine.
          r2 = 6
              Do While r2 < pivtrow2
                  If Worksheets("1M").Range("D" & r2).Value = "0" Then
                  Worksheets("1M").Rows(r2).EntireRow.Delete
                Worksheets("1M").Range("D" & r2).Value = "Zero"      'This line works if used instead of the deletion line, which suggests it's the actual deleting thats the problem
                 Else
                  r2 = r2 + 1
                 End If
                Loop
       
                
        
            .SaveAs Filename:=NewFile, FileFormat:=xlOpenXMLWorkbook
            .Close SaveChanges:=False

        End With
        
        'Create a new mail message
        Set OutlookMail = OutlookApp.CreateItem(0)

 

[Osvaldo Palmeiro]

Hi, Richard.
Try working bottom up. So, assuming pivtrow2 is the last row with data in column D, replace the Do While ... Loop by the bit of code below.

With Sheets("1M")
  For r2 = pivtrow2 To 6 Step -1
   If .Cells(r2, "D") = 0 Then .Rows(r2).Delete
  Next r2
 End With

 

[Richard1982]

Hi, Richard.
Try working bottom up. So, assuming pivtrow2 is the last row with data in column D, replace the Do While ... Loop by the bit of code below.

With Sheets("1M")
  For r2 = pivtrow2 To 6 Step -1
   If .Cells(r2, "D") = 0 Then .Rows(r2).Delete
  Next r2
 End With

Hi Osvaldo,

I was just trying that approach when I saw your message. This just throws up the same '400' error when it runs. Think I'll have to leave the zero lines in, can't see why it won't delete them! Maybe because the table is a pivot? I'm not sure.