Eliminate Blank cells and Move up Data Code

[jim may]

In My Range G20:G32 I Have:

[TABLE="width: 87"]
<tbody>[TR]
[TD="class: xl64, width: 87"] Excel 2010

	G
Able
Bob
Cathy
Daryl
Edward
Fred
Marvin
Pete

<colgroup><col style="width: 25pxpx"><col></colgroup><thead>
</thead><tbody>
[TD="align: center"]20[/TD]

[TD="align: center"]21[/TD]

[TD="align: center"]22[/TD]
[TD="align: right"][/TD]

[TD="align: center"]23[/TD]

[TD="align: center"]24[/TD]
[TD="align: right"][/TD]

[TD="align: center"]25[/TD]

[TD="align: center"]26[/TD]

[TD="align: center"]27[/TD]

[TD="align: center"]28[/TD]
[TD="align: right"][/TD]

[TD="align: center"]29[/TD]

[TD="align: center"]30[/TD]
[TD="align: right"][/TD]

[TD="align: center"]31[/TD]
[TD="align: right"][/TD]

[TD="align: center"]32[/TD]

</tbody>

Sheet1​

[/TD]
[/TR]
</tbody>[/TABLE]

This code is not working - Can someone REPAIR my FAULTY LOGIC?

Sub EliminateBlankRows()
LR = Range("G" & Rows.Count).End(xlUp).Row
Set Rng = Range("G20:G" & LR)
Application.Calculation = xlCalculationManual
With Rng
    For i = LR To Rng(1).Row + 1 Step -1
        If Cells(i, 7).Value = "" Or Cells(i, 7).Offset(-1).Value = "" Then
            Application.CutCopyMode = False
            Cells(i, 7).Cut Destination:=Cells(i, 7).Offset(-1, 0)
            i = i - 1
        Else
'        j = j - 1
'        i = i + j
        End If
    Next i
End With
Application.Calculation = xlCalculationAutomatic
End Sub

 

[Scott T]

Try

Sub delblank()
Dim lr As Long
lr = Cells(Rows.Count, "G").End(xlUp).Row

For i = lr To 20 Step -1
    If Cells(i, "G") = "" Then Cells(i, "G").Delete Shift:=xlUp
Next i
End Sub

 

[jim may]

Thanks Scott -- works great!!

 

[Fluff]

Another way

Sub jim_may()
   Range("G20:G32").SpecialCells(xlBlanks).Delete xlUp
End Sub