CODEWITHSUNDEEP
vbaexcel
user1766709
user1766709

Reputation: 69

Excel copy rows down to blank cells

I am trying to copy rows that contain data (in cells A, B, C, D) down into the same cells (in the different rows) if the cells are blank. So basically copying the data in the above cells if the preceding cells are empty. The code I have is as follows:

Sub PadOut()
With Range("A2:D300") ' change this
  On Error Resume Next
  Set aRange = .SpecialCells(xlCellTypeBlanks)  'check for blank cells
  On Error Goto 0
  If Not aRange Is Nothing Then   
     aRange.FormulaR1C1 = "=R[-1]C"   
     .Value = .Value   
  End If
End With
End Sub

Currently I have it at a set range.. But how can I set so as the range can be expanded (if I didn't know the number of total rows)

Upvotes: 1

Views: 1725

Answers (4)

DiegoAndresJAY
DiegoAndresJAY

Reputation: 706

Sub PadOut()
lastRow = ActiveSheet.UsedRange.Rows.Count
if cells(lastRow, 1) = "" and cells(lastRow, 2) = "" and cells(lastRow, 3) = "" and cells(lastRow, 4) = "" then
  lastRow = WorksheetFunction.Max(cells(lastRow, 1).end(xlup).row, cells(lastRow, 2).end(xlup).row, cells(lastRow, 3).end(xlUp).row, cells(lastRow, 4).end(xlup).row)
end if

With Range("A2:D" & lastRow)
  On Error Resume Next
  Set aRange = .SpecialCells(xlCellTypeBlanks)  'check for blank cells
  On Error Goto 0
  If Not aRange Is Nothing Then   
     aRange.FormulaR1C1 = "=R[-1]C"   
     .Value = .Value   
  End If
End With
End Sub

Upvotes: 1

stucharo
stucharo

Reputation: 855

Is this what you're trying to achieve? You can change the start row and column number as neccessary. The endCol variable defines the last colulmn to scan through and the endRow loop finds the last used row in the defined column range.

Sub PadOut()

    Application.ScreenUpdating = False

    Dim startRow As Long
    startRow = 2
    Dim startCol As Long
    startCol = 1
    Dim endCol As Long
    endCol = 3

    With ActiveSheet

        Dim row As Long
        Dim col As Long
        Dim endRow As Long

        Dim bottomRow As Long
        bottomRow = ActiveSheet.Rows.Count
        Dim colEndRow As Long
        endRow = 0
        For col = startCol To endCol
            If (Cells(bottomRow, col).End(xlUp).row > endRow) Then
                endRow = Cells(bottomRow, col).End(xlUp).row
            End If
        Next col

        For col = startCol To endCol
            For row = startRow + 1 To endRow
                If .Cells(row, col).value = "" Then
                    .Cells(row, col).value = .Cells(row - 1, col).value
                End If
            Next row
        Next col

    End With

    Application.ScreenUpdating = True

End Sub

Upvotes: 1

iamstrained
iamstrained

Reputation: 164

You don't really need VBA for this task. It can be accomplished with use of the selection page and array filling.

To do this: Highlight your range, starting with the first row and cell that has blank data you are interested in filling. Next, press CTRL+G, this will display the "Go To" window, press Special.... Select the "blanks" option and press OK. This will select all BLANK cells in your range. Then, without clicking (or you will change your selection), type: = {Press UP arrow} then press CTRL + ENTER

Your Data Before // Your Data After

enter image description here enter image description here

Upvotes: 0

codedude
codedude

Reputation: 6519

You can get the total number of rows using the following:

numberRows = ActiveSheet.UsedRange.Rows.Count

Then you can set up the range accordingly.

Upvotes: 0

Related Questions