Eliminate empty rows and shift not empty rows on the left

[Nelson78]

Hello everybody.

In the range A1:J10 I have a situation like this

https://imgur.com/ukRGiNG

I need to eliminate the empty rows (3, 4, 6 e 9) end shift the not empty rows on the left, so that no empty cells

https://imgur.com/a/tXxE4rc

I have tried something like this to eliminate the rows with a check on column F, but I am not convinced about.

                    Dim ic As Variant
                    Dim ir As Long
                    Dim x As Long
                        ic = 6 
                        ir = 1
                            For x = 1 To 10
                                    If Cells(ir, ic) = Empty Then
                                        Cells(ir, ic).EntireRow.Delete
                                    End If
                                ir = ir + 1
                                x = x + 1
                            Next

 

[Peter_SSs]

If your sample data is representative, then give this a try in a copy of your workbook

Sub Eliminate_Blanks()
  Application.ScreenUpdating = False
  On Error Resume Next
  Range("A1", Cells.SpecialCells(xlLastCell)).SpecialCells(xlBlanks).Delete Shift:=xlToLeft
  Columns("A").SpecialCells(xlBlanks).EntireRow.Delete
  On Error GoTo 0
  Application.ScreenUpdating = True
End Sub

 

[Nelson78]

If your sample data is representative, then give this a try in a copy of your workbook

Sub Eliminate_Blanks()
  Application.ScreenUpdating = False
  On Error Resume Next
  Range("A1", Cells.SpecialCells(xlLastCell)).SpecialCells(xlBlanks).Delete Shift:=xlToLeft
  Columns("A").SpecialCells(xlBlanks).EntireRow.Delete
  On Error GoTo 0
  Application.ScreenUpdating = True
End Sub

Perfect, it works fine.

Thank's.

 

[Peter_SSs]

Perfect, it works fine.

Thank's.

You're welcome. Glad to help.