VBA Deleting rows from specific cells based on some condition

[shah]

I found a code online which works but I am failing to change it for my purpose. Each entry in my spreadsheet contains different formulas as well as an Iferror function with the aim of making cells with error messages appear as blank. For example lets say a cell E3 is dependent on cell F3 with a certain formula (for clarification lets say F3/2.5). It is obvious if there is no entry in cell F3 then an error message would display in cell E3. For this reason, I use the IFERROR function to display the cell as blank. The difficulty arises when I want to delete blank rows after a click on the macro button. However, since that cell does have an entry (a formula which in turn returns an error message), that cell does not delete. Also I need to run this code over 3 different selection ranges. Please can someone help! The code I found was from a different thread on this forum and is:

sub foo
dim r As Range, rows As Long, i As Long
Set r = ActiveSheet.Range"A1:Z50"
rows = r.rows.Count
For i = rows To Step (-1)
If WorksheetFunction.CountA r.rows i = 0 Then
r.rows i.Delete
Next
End Sub

Thanks Alot!

[mancubus]

?

Sub vbax_57762_delete_blank_rows_formula_result()
    With Worksheets("Sheet1") 'change Sheet1 to suit
        .AutoFilterMode = False
        .Cells(1).AutoFilter Field:=5, Criteria1:="=" 'change column number, 5, to suit
        .UsedRange.Offset(1).SpecialCells(12).EntireRow.Delete
        .AutoFilterMode = False
    End With
End Sub

[shah]

Hi Mancubus, I used cell E as an example and many columns and cells in the spreadsheet have this kind of formula. Is there a way to generalise so it looks and makes sure that all rows are blanks before deleting?

[shah]

Hi, from the code you have given, i get an error message for this line

.Cells(1).AutoFilter Field:=2, Criteria1:="="

The code says AutoFilter method of range class failed?

[p45cal]

You could replace the If line with:
If Evaluate("Sumproduct(len(" & r.rows(i).Address & "))") = 0 Then r.rows(i).Select
after testing changing .Select to .Delete with the appropriate xlShiftToLeft or xlShiftUp after it.

[shah]

Hi p45cal, Thank you so much that worked!

[p45cal]

If you wanted, you could have a foo2:

Sub foo2(r As Range)
Dim rows As Long, i As Long
rows = r.rows.Count
For i = rows To 1 Step -1
  If Evaluate("Sumproduct(len(" & r.rows(i).Address & "))") = 0 Then r.rows(i).Delete xlShiftUp
Next
End Sub

then if you have a selection of cells, even a noncontiguous selection of cells such as A6:D12,A15:D19,A23:D34, you could call it like this:

Sub test()
foo2 ActiveSheet.Range("A6:F13")
End Sub

or

Sub blah()
Dim are As Range
For Each are In Range("A6:D12,A15:D19,A23:D34").Areas
  foo2 are
Next are
End Sub

or:

Sub blah()
Dim are As Range
For Each are In Selection.Areas
  foo2 are
Next are
End Sub

Second thoughts post posting, you might have to be VERY CAREFUL with multiselections; you should select from the bottom up: lowest range on the sheet first, then the next one up , etc. Likewise with the likes of
Range("A6:D12,A15:D19,A23:D34").Areas
it should be
Range("A23:D34,A15:D19,A6:D12").Areas
Third thought post posting, scrub that last; Excel seems to handle it OK, but be aware that if the noncontiguous ranges have columns which overlap, but not totally, then things could get messy. If that's the case then come back, there is a more robust way.

[shah]

Thank you much appreciated p45cal!

[shah]

Hi p45cal, this code does work but a message comes up saying that this would cause excel to unmerge merged cells. Is there a way of somehow making this message not come up?

You could replace the If line with:
If Evaluate("Sumproduct(len(" & r.rows(i).Address & "))") = 0 Then r.rows(i).Select
after testing changing .Select to .Delete with the appropriate xlShiftToLeft or xlShiftUp after it.

[shah]

/

[shah]

now I've sorted that the if line returns an error! saying line mismatch?

[p45cal]

Hi p45cal, this code does work but a message comes up saying that this would cause excel to unmerge merged cells. Is there a way of somehow making this message not come up?

You could try adding:
Application.DisplayAlerts=False
as the firstline of the sub, and:
Application.DisplayAlerts=False
as the last line of the sub.

Untested.

[shah]

hi p45cal,

Now thank you for that. now the if evaluate line is returning the same error message as earlier. It says "run-time error 13: Type mismatch". When I click on debug, the code with the line If(Evaluate("Sumproduct(len(" & r.rows(i)Address & "))") = 0 Then r.rows(i).Delete xlShiftUp is highlighted in yellow up to and including Then. I am sorry to keep hassling you! Please let me know if you have any suggestion. Shall I share my full code as it is right now if it would make it easier?

Thanks in advance!

You could try adding:
Application.DisplayAlerts=False
as the firstline of the sub, and:
Application.DisplayAlerts=False
as the last line of the sub.

Untested.

[p45cal]

hi p45cal,

Now thank you for that. now the if evaluate line is returning the same error message as earlier. It says "run-time error 13: Type mismatch". When I click on debug, the code with the line If(Evaluate("Sumproduct(len(" & r.rows(i).Address & "))") = 0 Then r.rows(i).Delete xlShiftUp is highlighted in yellow up to and including Then. I am sorry to keep hassling you! Please let me know if you have any suggestion. Shall I share my full code as it is right now if it would make it easier?

Thanks in advance!

You missed out a full stop (added in red in the quote above).

[shah]

Hi, that full stop is in the code already.. when i typed in here i missed it out. anything else you can think of?

You missed out a full stop (added in red in the quote above).

[p45cal]

when i typed in here i missed it out.

Copy/pasting is far less error prone.
That line should be:
If Evaluate("Sumproduct(len(" & r.rows(i).Address & "))") = 0 Then r.rows(i).Delete xlShiftUp
(no open parentheses after If.)
Yes, the full code would be good, but don't type it, copy/paste it.

[shah]

Hi p45cal,

I am still getting the run-time error '13' code. Would sharing the whole code i have in place be more help to see what the problem is?

Copy/pasting is far less error prone.
That line should be:
If Evaluate("Sumproduct(len(" & r.rows(i).Address & "))") = 0 Then r.rows(i).Delete xlShiftUp
(no open parentheses after If.)
Yes, the full code would be good, but don't type it, copy/paste it.

[p45cal]

Would sharing the whole code i have in place be more help to see what the problem is?

Yes! I said as much in the last message:

Yes, the full code would be good, but don't type it, copy/paste it.

[shah]

Oops sorry. This code is doing many things. It's looking to make sure a cell value doesnt exceed the value of a different cell. It deleted blank rows in a given range and it then creates a new copy of the file closing the original and saves it in a different location. The code is

Sub CommandButton1_Click()
ActiveSheet.Unprotect Password:="PASSWORD"
If (Range("C3") = "Change") Then
MsgBox "Total Gross Cost cannot exceed total budget for campaign."
Exit Sub
End If
        ActiveSheet.Copy
         Dim r As Range, rows As Long, i As Long
Set r = ActiveSheet.Range("B18:AC74")
rows = r.rows.Count
For i = rows To 1 Step (-1)
Application.DisplayAlerts = False
If Evaluate("Sumproduct(len(" & r.rows(i).Address & "))") = 0 Then r.rows(i).Delete xlShiftUp
Next
 Dim SaveName As String
SaveName = ActiveSheet.Range("C5").Text
    ActiveSheet.Protect Password:="PASSWORD"
    With ActiveWorkbook
    .Worksheets("Media Plan").CommandButton1.Visible = False
.SaveAs "S:\Data\" & SaveName & ".xls"
End With
    Workbooks.Open ("S:\Data\" & SaveName & ".xls")
Workbooks("Media Plan Template Macr Version Check - v2.xlsb").Close False
    End Sub

Thanks once again!

Yes! I said as much in the last message:

[p45cal]

Where is this code? A standard code-module, a sheet's code module. If you don't understand this question, tell me the name of the code module it's in (Module1, Module2, Sheet1, Sheet2)).

You could try changing to:

  If Evaluate("Sumproduct(len(" & r.rows(i).Address(external:=True) & "))") = 0 Then r.rows(i).Delete xlShiftUp