PDA

View Full Version : VBA Deleting rows from specific cells based on some condition



shah
11-18-2016, 03:59 AM
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
11-18-2016, 04:37 AM
?



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
11-18-2016, 04:42 AM
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
11-18-2016, 05:00 AM
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
11-18-2016, 05:02 AM
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
11-18-2016, 05:11 AM
Hi p45cal, Thank you so much that worked!

p45cal
11-18-2016, 05:15 AM
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
11-18-2016, 06:44 AM
Thank you much appreciated p45cal!

shah
11-23-2016, 07:29 AM
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
11-23-2016, 07:35 AM
/

shah
11-23-2016, 08:04 AM
now I've sorted that the if line returns an error! saying line mismatch?

p45cal
11-23-2016, 08:46 AM
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
11-23-2016, 09:33 AM
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
11-23-2016, 10:05 AM
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
11-23-2016, 10:15 AM
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
11-23-2016, 02:10 PM
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
11-24-2016, 01:52 AM
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
11-24-2016, 05:31 AM
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
11-24-2016, 06:50 AM
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
11-24-2016, 07:19 AM
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

shah
11-24-2016, 07:36 AM
It's in Sheet1 which is called Media Plan. Was this the answer for your question? I tried using that code you gave but it didn't work. It still highlights up until and including Then.


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

shah
11-24-2016, 07:49 AM
It is in Sheet1 which is called the Media Plan. The alternate proposed code also doesn't work with the same error message. It highlights the code up to and including Then same as previous line.


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

p45cal
11-24-2016, 08:41 AM
I think I've found the problem; you have errors in some of the cells you're examining.
You can confirm this by trying to run the code again, then when it complains, choose debug and in the Immediate pane of the VBE type:
r.rows(i).select
and press Enter. Look at the active sheet and see if there are any errors in those selected cells.
If this is the case how do you want to deal with this row? Do you want to examine it further? Perhaps you want to delete it.. or not?
You should keep the external:=true by the way.

shah
11-24-2016, 10:28 AM
Hi p45cal, it didn't select any cell and instead returns an error saying wun-time error '424': Object required?


I think I've found the problem; you have errors in some of the cells you're examining.
You can confirm this by trying to run the code again, then when it complains, choose debug and in the Immediate pane of the VBE type:
r.rows(i).select
and press Enter. Look at the active sheet and see if there are any errors in those selected cells.
If this is the case how do you want to deal with this row? Do you want to examine it further? Perhaps you want to delete it.. or not?
You should keep the external:=true by the way.

p45cal
11-24-2016, 04:30 PM
We're getting different error messages! That last one is fundamental.
FYI the code runs fine here, wherever the code is located.
1. I suggest a brief TeamViewer session
2. Could you nvertheless take a look at the rows in B18:AC74 and tell me (a) are there formulae in any of the cells and (b) are there errors in any of the cells?

shah
11-25-2016, 02:08 AM
Hi p45cal,

The cells within the range of B18:AC74 do have formulas. Due to the way they are coded, there are errors in some cells and this can vary depending on the value on some of the cells. This is something that will happen since the sheet I am making will have times where some values are blank and can lead to other depending cells with the error message. Also, there are some merged cells in there too.

shah
11-25-2016, 02:10 AM
Following from my previous message, this code was working perfectly fine until a couple days ago when it started giving me this error message!


We're getting different error messages! That last one is fundamental.
FYI the code runs fine here, wherever the code is located.
1. I suggest a brief TeamViewer session
2. Could you nvertheless take a look at the rows in B18:AC74 and tell me (a) are there formulae in any of the cells and (b) are there errors in any of the cells?

shah
11-25-2016, 02:10 AM
Is there something else i could put it instead of the IF Evaluate line?

p45cal
11-25-2016, 03:28 AM
Is there something else i could put it instead of the IF Evaluate line?Yes there is,but what depends on how you want to deal with those errors. I did ask you before:
If this is the case how do you want to deal with this row? Do you want to examine it further? Perhaps you want to delete it.. or not?
However, your last 424 error won't go away - we still need to use r. It may be that r is defined elsewhere so we have to change r for another name - I just don't know. Now I can ask lots of questions, guessing what the problem might be, but it's taking too long (here we are at msg#29) - which is why I suggested a TeamViewer session (also I'm intrigued as to what the bug is caused by).
Alternatively, supply a file where the error is occurring.

Merged cells? They are nothing but problems with macros, don't use them. I thought we'd dealt with them.

Is this a Mac version of Excel?

p45cal
11-25-2016, 03:37 AM
By the way, you should read the rules before posting.
Have a look at http://www.excelguru.ca/content.php?184

shah
11-29-2016, 02:13 AM
Hi p45cal,

Im sorry if i offended you in any way. I just am desperate to get this code right since I am on a tight deadline. I only posted since i wasn't getting the solution and thought i'd have higher chances of receiving the answer if I posted elsewhere. Once again I am sorry if i offended you. Now the code works however now it doesn't delete the blank rows.


By the way, you should read the rules before posting.
Have a look at http://www.excelguru.ca/content.php?184

p45cal
11-29-2016, 08:23 AM
Now the code works however now it doesn't delete the blank rows.If you don't answer my questions, how do I know (a) what you want, and (b) how to code for it!?

Regarding the rules, cross posting is OK as long as you tell everyone you have done it. This does require you to do something. Please read the link in message#30.
I'm not a moderator here so I can't insist. (However I am a moderator elsewhere and at those places I do insist!)