CODEWITHSUNDEEP
vbaexcel
James G
James G

Reputation: 23

Loop to delete blank cells from a column

I need to delete the blank cells in column F from F4 on down. There will be between 0 and lots of blank cells per row.

I'm very new to coding, and my most successful approach has been to take code that did something similar and cannibalized it.

Here's the code that worked for something similar:

Sub test()
Dim i As Long
With Worksheets("Sheet1")
    For i = 4 To .Cells(.Rows.Count, "F").End(xlUp).Row
        Do While .Cells(i, "F").Value2 = .Cells(1, "B").Value2 And Not 
IsEmpty(.Cells(i, "F"))
            .Cells(i, "F").Resize(1, 4).Delete shift:=xlToLeft
        Loop
Next i
End With
End Sub

And here's what I tried to do with it:

Sub test()
Dim i As Long
With Worksheets("sheet1")
For i = 4 To .Cells(.Rows.Count, "F").End(xlUp).Row
    Do While .Cells(i, "F").Value2 = ""
        .Cells(i, "F").Resize(1, 4).Delete shift:=xlToLeft
    Loop
Next i
End With
End Sub

I don't get any errors when I run it, but it doesn't work either.

Any guidance is appreciated!

Upvotes: 0

Views: 1126

Answers (3)

Ahmed AU
Ahmed AU

Reputation: 2777

Assuming 1. intent of the code is to only eliminate blanks in column F 2. deletion of entire row is uncalled for. 3. deleting cell xlLeft will inadvertently put the content (or blank cell) of Column G into column F. the following code may be tried

   Sub test()
   Dim i As Long
   With Worksheets("sheet1")
   For i = .Cells(.Rows.Count, "F").End(xlUp).Row To 4 Step -1
       If .Cells(i, "F").Value2 = "" Then
      .Range(.Cells(i + 1, "F"), .Cells(.Cells(.Rows.Count, "F").End(xlUp).Row, "F")).Cut
      .Cells(i, "F").Select
      .Paste
       End If
    Next i
    End With
    End Sub

Upvotes: 0

MT32
MT32

Reputation: 677

Try this:

Sub test()
Dim i As Long
Dim lastrow as integer

With Worksheets("sheet1")
lastrow= cells(rows.count, 6).end(xlup).row     'define your last filled row

For i = 4 To lastrow
    if IsEmpty(cells(i,6))= TRUE then
    Cells(i,6).Delete shift:=xlToLeft
Next i
End With
End Sub

However, I normally find deleting cells from the bottom up works better. So....perhaps you could try this as well:

Sub test()
Dim i As Long
Dim lastrow as integer

With Worksheets("sheet1")
lastrow= cells(rows.count, 6).end(xlup).row     'define your last filled row

For i = lastrow To 4 step -1
    if IsEmpty(cells(i,6))= TRUE then
    Cells(i,6).Delete shift:=xlToLeft
Next i
End With
End Sub

Upvotes: 0

nutsch
nutsch

Reputation: 5962

You are deleting blank cells by shifting the cells to the right in their place. If these cells are blank too, nothing will appear to change. If you want to remove the entire row instead, change your code to this: 

Sub test()
Dim i As Long
With Worksheets("sheet1")
For i =  .Cells(.Rows.Count, "F").End(xlUp).Row to 4 Step-1
    IF .Cells(i, "F").Value2 = ""
        .Cells(i, "F").entirerow.Delete shift:=xlUp
    Loop
Next i
End With
End Sub

Upvotes: 1

Related Questions