filling up empty cells in VBA

Question

I have a problem with my VBA code in Excel. My table consists of a few columns with different lengths. In front of every of these columns I want to show the actual ID of the block(not the problem). The thing is that the actual ID only occurs in the first row of the block so there is a certain amount of empty cells under every block ID.

I found a code with which I can fill these empty cells with the actual block ID:

Sub Leere_auffuellen()
    With Worksheets(3).Range("A5:A1000")
        If Application.WorksheetFunction.CountBlank(Intersect(.Cells,  .Parent.UsedRange)) > 0 Then
            .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
            .Value = .Value
        End If
End Sub

This works for the longest column. My problem is that I want to do that for the shorter columns, too. If I use the code above, it fills the rows with IDs until the length of the longest row is reached. How can I adjust the code so that it refers to the column I want it to?

I hope you guys understand what I want

You are telling your code to run in column A from row 5 to 1000 (`Range("A5:A1000")`). Instead, first try to get the actual number of rows (look [here](http://stackoverflow.com/a/71310/1726522)), and then define the range accordingly. You also may want to add a loop for dealing with many columns. — CMArg, Mar 10 '17 at 11:12

score 0 · Answer 1 · answered Mar 10 '17 at 14:01

Try this

Sub Leere_auffuellen()

Dim x As Long
Dim LastRow As Long
Dim LastCol As Long
Dim DataStarted As Boolean
DataStarted = False

'Activate target worksheet.
Worksheets(3).Activate
'Find the last row with data.
LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

For x = 1 To LastRow
    'Don't do anything until the first time a non-blank cell in column A is reached.
    If Cells(x, 1) <> "" Then
        DataStarted = True
    'Then if there are blanks in the row, fill them in with the data from the cell above.
    ElseIf DataStarted Then
        LastCol = Rows(x - 1).Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
        With Range(Cells(x, 1), Cells(x, LastCol))
            .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
            .Value = .Value
        End With
    End If
Next x

End Sub

filling up empty cells in VBA

1 Answers1