Solved: Delete Empty cells with condition

Hi xld,

I posted the issue in another post and following THIS it works perfectly now. No more freezing, all the tables on the side intact. The only things that's not working now is the formulas and formatting all the way down to row 207.

This happens even thought i Added and increment to

[VBA]lastrow = .UsedRange.Rows.Count + 10[/VBA]

Also it leaves my columns "H:I" visible. This i can solve with (my humble contribution):

[VBA]ActiveSheet.Columns("H:I").Hidden = True[/VBA]

thanks for the help.

Given that your post there is not many hours ago, why not wait for a solution there. If nothing happens then post here for assistance. Hunting for a solution over many forums on the same topic gets people a bad reputation and therefore less likely to be given assistance

Hi guys, thanks a lot for the help. I am sorry Aussiebear I thought this was already kinda dead. I am very happy to know that you guys monitor the forum so users always get. I will be more patient next time.

Here is my final code. I got it from this forum

[VBA]Sub test()
Dim a, b(), i As Long, ii As Long, n As Long, flg As Boolean
With Range("a2", Range("a" & Rows.Count).End(xlUp)).Resize(, 2)
a = .Value
Redim b(1 To UBound(a, 1), 1 To UBound(a, 2))
For i = 1 To UBound(a, 1)
If a(i, 2) = "" Then
Select Case a(i, 1)
Case "Cookies", "Salt", ""
n = n + 1
flg = True
Case Else
End Select
Else
n = n + 1: flg = True
End If
If flg Then
For ii = 1 To UBound(a, 2)
b(n, ii) = a(i, ii)
Next
End If
flg = False
Next
.Value = b
End With
End Sub
[/VBA]

this is a closed threat

if worksheets("sheetname").range("b1")="" then
range("b1").delete
end if

you could use EntireRow function for Selection.Rows(row number).EntireRow.Delete

Hi rackjackson,

I cannot use that one because there is data next to this table that I do not want to delete

Sorry for the slow response. ?

Is this something along the lines that you are trying to do?

[VBA]Sub dave()
Dim cl(), lr, j, jj, val()
Application.ScreenUpdating = 0
lr = Cells(Rows.Count, 1).End(xlUp).Row
ReDim cl(1 To 2, 1 To lr)
ReDim val(1 To 2, 1 To lr)
x = 1
For i = 2 To lr
j = Cells(i, 1).Value
jj = Cells(i, 2).Value
If j = "Cookies" Or j = "Salt" Or jj <> "" Then
val(1, x + 1) = Cells(i + 1, 1).Value
If val(1, x + 1) <> "Cookies" Then
cl(1, x) = j
cl(2, x) = jj
x = x + 1
End If
End If
Next i
ReDim Preserve cl(1 To 2, 1 To x - 1)
Cells(2, 1).Resize(lr, 2).ClearContents
Cells(2, 1).Resize(x - 1, 2).Value = Application.Transpose(cl)
ActiveSheet.ListObjects("Table1").Resize Range("$A$1:$B$" & x)
Application.ScreenUpdating = 1
End Sub[/VBA]