Solved: Delete Empty cells with condition

[fredlo2010]

Hello,

OK I want to delete cells in a spreadsheet based on the contents of Column B

I am gonna word it out so you can understand:

I want to delete all rows in a spreadsheet that contain no data in column B, as long as the data in column A is not "Cookies", or "Salt". The range of cells I want to delete spams from "A7:G7". when deleting this I want to shift the cells up because there is data beyond column "G" that I want to maintain.

After the cells are deleted I will have to restore my formula(s) down until "B200:G200"

Also there is a conditional formatting rule to shade every other row that always gets messed up, I would like it restored to cover the Range "A7:G200" The formula I am using is " =MOD(ROW(),2)=1"

Then I will reset the print area, for that I made this code (not too much to brag about):

[VBA]Sub SetPrintArea()

If Not Sheets("Sheet1").Range("A34").Value = "" Then
ActiveSheet.PageSetup.PrintArea = Range("A1:N1", Range("A" & Rows.Count).End(xlUp)).Address
Else
ActiveSheet.PageSetup.PrintArea = Range("A1:N34").Address
End If

End Sub
[/VBA]

I made a small sample of my document. Not all the columns were included. Delete Empty rows.xls

Thanks any help will be more than welcome

BTW this is an updated version of my original post http://www.vbaexpress.com/forum/showthread.php?t=42305 I desided to remove the table and use normal ranges because I was having problems with my other copy paste macros. Any ways what I was looking for was the alternating row shading and i got that with my formula.

[Bob Phillips]

[VBA]Public Sub DeleteData()
Const FORMULA_CHECK As String = "=AND(B3="""",NOT(OR(A3={""Cookies"",""Salt""})))"
Dim rng As Range
Dim lastrow As Long
Dim i As Long

With ActiveSheet

.Columns("E").Insert
.Rows(1).Insert shift:=xlDown

lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("E1").Value = "temp"
.Range("E2").Value = "FALSE"
Set rng = .Range("A1").Resize(lastrow, 5)
.Range(rng.FormatConditions(1).AppliesTo.Address).FormatConditions(1).Delet e
.Range("E3").Resize(lastrow - 2).Formula = FORMULA_CHECK
rng.AutoFilter Field:=5, Criteria1:="TRUE"
Set rng = rng.SpecialCells(xlCellTypeVisible)
rng.Delete shift:=xlUp

.Columns("E").Delete

lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set rng = .Range("A2").Resize(lastrow - 1, 4)
rng.FormatConditions.Add Type:=xlExpression, Formula1:="=MOD(ROW(),2)=1"
rng.FormatConditions(1).Interior.ColorIndex = 15
End With
End Sub[/VBA]

[fredlo2010]

Hi,

Xld thanks a lot for the quick response. This works. There is only an issue I forgot to mention before

My data actually starts at range "A7:G7"

The range above that contains also some merged cells.

Also my cell K29 lost its borders

[fredlo2010]

Hi,

I made a mistake. My real sheets looks a little different than mine does. So here is the updated version. I am sorry about this. But I was thinking that I was gonna get a solution using ranges and that i was going to be able to easily modify them.

Here is the file Delete Empty rows.xls


The code above is very hard for me to read or understand.

Sorry for that

[fredlo2010]

Can you guys help me with this. I have tried to modify this but nothing seems to work.

Thanks

I tried to Modify the original code and it works. But for some reason part of my table next to the main one gets deleted.

Here is the code I got

[VBA]Public Sub DeleteData()
Const FORMULA_CHECK As String = "=AND(B7="""",NOT(OR(A7={""Cookies"",""Salt""})))"
Dim rng As Range
Dim lastrow As Long
Dim i As Long

With ActiveSheet

.Columns("J").Insert
.Rows(5).Insert shift:=xlDown

lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("J5").Value = "temp"
.Range("J6").Value = "FALSE"
Set rng = .Range("A6").Resize(lastrow, 10)
.Range(rng.FormatConditions(1).AppliesTo.Address).FormatConditions(1).Delet e
.Range("J7").Resize(lastrow - 2).Formula = FORMULA_CHECK
rng.AutoFilter Field:=10, Criteria1:="TRUE"
Set rng = rng.SpecialCells(xlCellTypeVisible)
rng.Delete shift:=xlUp

.Columns("J").Delete

lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set rng = .Range("A6").Resize(lastrow - 1, 9)
rng.FormatConditions.Add Type:=xlExpression, Formula1:="=MOD(ROW(),2)=1"

rng.FormatConditions(1).Interior.ColorIndex = 15
End With
End Sub
[/VBA]

Also when I run it more than once then I get an error in this line

[VBA].Range(rng.FormatConditions(1).AppliesTo.Address).FormatConditions(1).Delet e[/VBA]

[Bob Phillips]

See if this works

[VBA]Public Sub DeleteData()
Const FORMULA_CHECK As String = "=AND(B<start>="""",NOT(OR(A<start>={""Cookies"",""Salt""})))"
Const FORMULA_SUBTOTAL = "=IF(B<start+>="""","""",B<start+>*ROW(B<start+>)+68)"
Const FORMULA_PCTOTAL = "=IFERROR(D<start>*0.25,"""")"
Const FORMULA_WEIGHT = "=IFERROR(D<start>-E<start+>,"""")"
Const FORMULA_TOTALWEIGHT = "=IFERROR(E<start>-F<start+>,"""")"
Const HEADER_ROW As Long = 6
Dim rng As Range
Dim lastrow As Long
Dim numcols As Long
Dim i As Long

With ActiveSheet

numcols = .Cells(HEADER_ROW, "A").End(xlToRight).Column
.Columns(numcols + 1).Insert
.Rows(HEADER_ROW).Insert shift:=xlDown

lastrow = .UsedRange.Rows.Count
.Cells(HEADER_ROW, numcols + 1).Value = "temp"
.Cells(HEADER_ROW + 1, numcols + 1).Value = "FALSE"
Set rng = .Cells(HEADER_ROW, "A").Resize(lastrow, numcols + 1)
On Error Resume Next
rng.Offset(2, 0).FormatConditions(1).Delete
On Error GoTo 0
.Cells(HEADER_ROW + 2, numcols + 1).Resize(lastrow - 2).Formula = Replace(FORMULA_CHECK, "<start>", HEADER_ROW + 2)
rng.AutoFilter Field:=numcols + 1, Criteria1:="TRUE"
Set rng = rng.SpecialCells(xlCellTypeVisible)
rng.Delete shift:=xlUp

.Columns(numcols + 1).Delete

lastrow = .UsedRange.Rows.Count
Set rng = .Cells(HEADER_ROW + 1, "A").Resize(lastrow - HEADER_ROW, numcols)
rng.FormatConditions.Add Type:=xlExpression, Formula1:="=MOD(ROW(),2)=1"
rng.FormatConditions(1).Interior.ColorIndex = 15
.Cells(HEADER_ROW + 1, "D").Resize(lastrow - HEADER_ROW).Formula = Replace(Replace(FORMULA_SUBTOTAL, _
"<start>", HEADER_ROW + 1), _
"<start+>", HEADER_ROW + 2)
.Cells(HEADER_ROW + 1, "E").Resize(lastrow - HEADER_ROW).Formula = Replace(Replace(FORMULA_PCTOTAL, _
"<start>", HEADER_ROW + 1), _
"<start+>", HEADER_ROW + 2)
.Cells(HEADER_ROW + 1, "F").Resize(lastrow - HEADER_ROW).Formula = Replace(Replace(FORMULA_WEIGHT, _
"<start>", HEADER_ROW + 1), _
"<start+>", HEADER_ROW + 2)
.Cells(HEADER_ROW + 1, "G").Resize(lastrow - HEADER_ROW).Formula = Replace(Replace(FORMULA_TOTALWEIGHT, _
"<start>", HEADER_ROW + 1), _
"<start+>", HEADER_ROW + 2)
End With
End Sub
[/VBA]

[fredlo2010]

Hi XLD,

This works but:

*The top row gets messed up again, some parts of it are deleted.

*my formula does not go all the way to row 207 so if the user wants to enter more data there is no formula

*My conditional formatting does not extended till 207 either.


I want to clean the list but leave the sheet set up so the user can input more data if chooses to. Run other macros that will bring in data from another state, ect..

Maybe I am thinking too flat but could't we just delete all the body rows (A7:I7), by shifting up so my data next to it does not get messed up. and then use a fill down from my formulas up to row 207. and then fix the range for the conditional formatting.

I don't know I think we are a little over thinking it or something.

Thanks

[Bob Phillips]

I don't see any headers getting messed, what are you seeing?

You can add some 'float' by adding an increment to where lastrow is calculated at the end.

[fredlo2010]

Hi xld,

Sorry for the delay. Here is an example of how the cells on the side moved. Also this part of the sheet is not static, I can have two, three or more summary little tables. Some of them contain formulas relating to the original set like SUM functions etc...

here is the file with the issue : Delete Empty rows (3).xls

I have literally dissected your code and cannot fix it at all. I can barely understand it. But its good It has shown me several features I can use in the future.

This is totally optional, but it would be great if you explain your code a little bit to me? if you don't mind.

BTW Whats

You can add some 'float' by adding an increment

The only information I found about it is here Blog

Thanks for the help

[Bob Phillips]

No problem, I am in no hurry .

That problem is very odd, it shouldn't happen, but see if this works for you

[VBA]Public Sub DeleteData()
Const FORMULA_CHECK As String = "=AND(B<start>="""",NOT(OR(A<start>={""Cookies"",""Salt""})))"
Const FORMULA_SUBTOTAL = "=IF(B<start+>="""","""",B<start+>*ROW(B<start+>)+68)"
Const FORMULA_PCTOTAL = "=IFERROR(D<start>*0.25,"""")"
Const FORMULA_WEIGHT = "=IFERROR(D<start>-E<start+>,"""")"
Const FORMULA_TOTALWEIGHT = "=IFERROR(E<start>-F<start+>,"""")"
Const HEADER_ROW As Long = 6
Dim rngArea As Range
Dim rng As Range
Dim lastrow As Long
Dim numcols As Long
Dim i As Long

With ActiveSheet

numcols = .Cells(HEADER_ROW, "A").End(xlToRight).Column
.Columns(numcols + 1).Insert
.Rows(HEADER_ROW).Insert shift:=xlDown

lastrow = .UsedRange.Rows.Count
.Cells(HEADER_ROW, numcols + 1).Value = "temp"
.Cells(HEADER_ROW + 1, numcols + 1).Value = "FALSE"
Set rng = .Cells(HEADER_ROW, "A").Resize(lastrow, numcols + 1)
On Error Resume Next
Do While rng.Offset(2, 0).FormatConditions.Count > 0
For i = 1 To rng.Offset(2, 0).FormatConditions.Count
rng.Offset(2, 0).FormatConditions(i).Delete
Next i
Loop
On Error GoTo 0
.Cells(HEADER_ROW + 2, numcols + 1).Resize(lastrow - 2).Formula = Replace(FORMULA_CHECK, "<start>", HEADER_ROW + 2)
rng.AutoFilter Field:=numcols + 1, Criteria1:="TRUE"
Set rng = rng.SpecialCells(xlCellTypeVisible)
For Each rngArea In rng.Areas
rngArea.Delete shift:=xlUp
Next rngArea

.Columns(numcols + 1).Delete

lastrow = .UsedRange.Rows.Count + 10
Set rng = .Cells(HEADER_ROW + 1, "A").Resize(lastrow - HEADER_ROW, numcols)
rng.FormatConditions.Add Type:=xlExpression, Formula1:="=MOD(ROW(),2)=1"
rng.FormatConditions(1).Interior.ColorIndex = 15
.Cells(HEADER_ROW + 1, "D").Resize(lastrow - HEADER_ROW).Formula = Replace(Replace(FORMULA_SUBTOTAL, _
"<start>", HEADER_ROW + 1), _
"<start+>", HEADER_ROW + 2)
.Cells(HEADER_ROW + 1, "E").Resize(lastrow - HEADER_ROW).Formula = Replace(Replace(FORMULA_PCTOTAL, _
"<start>", HEADER_ROW + 1), _
"<start+>", HEADER_ROW + 2)
.Cells(HEADER_ROW + 1, "F").Resize(lastrow - HEADER_ROW).Formula = Replace(Replace(FORMULA_WEIGHT, _
"<start>", HEADER_ROW + 1), _
"<start+>", HEADER_ROW + 2)
.Cells(HEADER_ROW + 1, "G").Resize(lastrow - HEADER_ROW).Formula = Replace(Replace(FORMULA_TOTALWEIGHT, _
"<start>", HEADER_ROW + 1), _
"<start+>", HEADER_ROW + 2)
End With
End Sub
[/VBA]

I thought after I had written it that my comment about float was unnecessarily obtuse. That article is good, but no what I was meaning. What I was referring go the spare formatted, formulated lines after your data to accommodate new entries, the float. If you look at the code, towards the end I calculate the lastrow and reinsert the formulas and add row striping. By simply incrementing that variable by say 10, the code will create a 10-row area for new items.

As for explaining it, let's get it fully working first, then I will give you a breakdown.

[fredlo2010]

Thanks xld,
I cannot test the last code you provided. It makes my excel to crash.

[Bob Phillips]

Well it is fine here, I have no idea what the problem might be.

[fredlo2010]

xld,

have you noticed that there hidden columns after "G"?

I just realized that those where not included in the code as constants. maybe that's the problem

[Bob Phillips]

I didn't notice that, but as I said, it worked here.

Notwithstanding, try this that handles those columns and see if it helps.

[VBA]Public Sub DeleteData()
Const FORMULA_CHECK As String = "=AND(B<start>="""",NOT(OR(A<start>={""Cookies"",""Salt""})))"
Const FORMULA_SUBTOTAL = "=IF(B<start+>="""","""",B<start+>*ROW(B<start+>)+68)"
Const FORMULA_PCTOTAL = "=IFERROR(D<start>*0.25,"""")"
Const FORMULA_WEIGHT = "=IFERROR(D<start>-E<start+>,"""")"
Const FORMULA_TOTALWEIGHT = "=IFERROR(E<start>-F<start+>,"""")"
Const FORMULA_NUMBERX As String = "=IFERROR(F<start>-G<start+>,"""")"
Const FORMULA_NUMBERY As String = "=IFERROR(G<start>-H<start+>,"""")"
Const HEADER_ROW As Long = 6
Dim rng As Range
Dim lastrow As Long
Dim numcols As Long
Dim i As Long

With ActiveSheet

.Columns("H:I").Hidden = False
numcols = .Cells(HEADER_ROW, "A").End(xlToRight).Column
.Columns(numcols + 1).Insert
.Rows(HEADER_ROW).Insert shift:=xlDown

lastrow = .UsedRange.Rows.Count
.Cells(HEADER_ROW, numcols + 1).Value = "temp"
.Cells(HEADER_ROW + 1, numcols + 1).Value = "FALSE"
Set rng = .Cells(HEADER_ROW, "A").Resize(lastrow, numcols + 1)
On Error Resume Next
Do While rng.Offset(2, 0).FormatConditions.Count > 0
For i = 1 To rng.Offset(2, 0).FormatConditions.Count
rng.Offset(2, 0).FormatConditions(i).Delete
Next i
Loop
On Error GoTo 0
.Cells(HEADER_ROW + 2, numcols + 1).Resize(lastrow - 2).Formula = Replace(FORMULA_CHECK, "<start>", HEADER_ROW + 2)
rng.AutoFilter Field:=numcols + 1, Criteria1:="TRUE"
Set rng = rng.SpecialCells(xlCellTypeVisible)
For Each rngArea In rng.Areas
rngArea.Delete shift:=xlUp
Next rngArea

.Columns(numcols + 1).Delete

lastrow = .UsedRange.Rows.Count
Set rng = .Cells(HEADER_ROW + 1, "A").Resize(lastrow - HEADER_ROW, numcols)
rng.FormatConditions.Add Type:=xlExpression, Formula1:="=MOD(ROW(),2)=1"
rng.FormatConditions(1).Interior.ColorIndex = 15
.Cells(HEADER_ROW + 1, "D").Resize(lastrow - HEADER_ROW).Formula = Replace(Replace(FORMULA_SUBTOTAL, _
"<start>", HEADER_ROW + 1), _
"<start+>", HEADER_ROW + 2)
.Cells(HEADER_ROW + 1, "E").Resize(lastrow - HEADER_ROW).Formula = Replace(Replace(FORMULA_PCTOTAL, _
"<start>", HEADER_ROW + 1), _
"<start+>", HEADER_ROW + 2)
.Cells(HEADER_ROW + 1, "F").Resize(lastrow - HEADER_ROW).Formula = Replace(Replace(FORMULA_WEIGHT, _
"<start>", HEADER_ROW + 1), _
"<start+>", HEADER_ROW + 2)
.Cells(HEADER_ROW + 1, "G").Resize(lastrow - HEADER_ROW).Formula = Replace(Replace(FORMULA_TOTALWEIGHT, _
"<start>", HEADER_ROW + 1), _
"<start+>", HEADER_ROW + 2)
.Cells(HEADER_ROW + 1, "H").Resize(lastrow - HEADER_ROW).Formula = Replace(Replace(FORMULA_NUMBERX, _
"<start>", HEADER_ROW + 1), _
"<start+>", HEADER_ROW + 2)
.Cells(HEADER_ROW + 1, "I").Resize(lastrow - HEADER_ROW).Formula = Replace(Replace(FORMULA_NUMBERY, _
"<start>", HEADER_ROW + 1), _
"<start+>", HEADER_ROW + 2)
End With
End Sub[/VBA]

failing that, reboot

[fredlo2010]

Nothing,

Still the same it freezes my Excel. I rebooted and I still get the same

[Bob Phillips]

Very odd, I just don't get that problem.

What system/Excel versions do you have?

[fredlo2010]

Windows vista excel 2010

[fredlo2010]

Hi xld,

I just tried the code at home. A way faster computer than the one at work. Running Windows 7 64 and Excel 2010. I still get the same, it freezes and does not respond.

[Bob Phillips]

Oh, my wife has vista so I was going to try it there, but I have 7 4-bit and Excel 2010, and no problem here. Is your Excel 64 bit or 32 bit (grasping at straws here)?

[Bob Phillips]

BTW, did this used to work and then the problem start happening after one particular change; which one?