Help with code to move blank cells

[steveo0707]

The following is the code I have for moving the blank rows located throughout a table in Excel. When I run the code, it is only moving the 1st and 3rd column blanks down. I have 7 total columns. Any help on this would be much appreciated.

Public Sub main()

  Dim oRange As Range
  Set oRange = Worksheets("Sheet1").Range("A3:G28")
  MoveData oRange
End Sub


Public Sub MoveData(ByRef oRange As Range)


   Dim i As Integer
   Dim j As Integer
   Dim oMoveRange As Range


   For i = 1 To oRange.Rows.Count
     If oRange.Value2(i, 1) = "" Then
       Set oMoveRange = oRange(i, 1).End(xlDown)
       If Intersect(oRange, oMoveRange) Is Nothing Then Exit Sub
         For j = 0 To 2 Step 2
           oRange(i, j + 1).Value = oMoveRange.Offset(0, j).Value
           oMoveRange.Offset(0, j).Value = ""
         Next
     End If
   Next
   
End Sub

 

[Yongle]

Not entirely sure what you are trying to move

This moves a row to the bottom of range if column A is empty

Sub MoveBlankRows()
    Dim ws As Worksheet:    Set ws = Worksheets("Sheet1")
    Dim cel As Range, r As Long
    Application.ScreenUpdating = False
    For r = 28 To 3 Step -1
        Set cel = Range("A" & r)
        If cel = "" Then
            cel.Resize(, 7).Cut
            Range("A29").Insert Shift:=xlDown
        End If
    Next r
End Sub

 

[steveo0707]

Hello Yongle,

Thank you for the response. I am trying to scan data table and move all blank rows to the bottom.

 

[Yongle]

Try this minor amendment

Sub MoveBlankRows()
    Dim ws As Worksheet:    Set ws = Worksheets("Sheet1")
    Dim cel As Range, r As Long
    Application.ScreenUpdating = False
    For r = 28 To 3 Step -1
        Set cel = Range("A" & r)
        [COLOR=#ff0000]If WorksheetFunction.CountBlank(Rows(cel.Row)) = Columns.Count[/COLOR] Then
            cel.Resize(, 7).Cut
            Range("A29").Insert Shift:=xlDown
        End If
    Next r
End Sub

You could amend the same line to simply test the columns in the table are blank

[COLOR=#ff0000]If WorksheetFunction.CountBlank([/COLOR][COLOR=#ff0000]cel.Resize(, 7)) = 7[/COLOR] Then

 

[steveo0707]

Hello Yongle,

That worked perfectly! Thank you so much!