Auto fill down cell in Excel VBA Macro

Question

Sub AutoFill()

    Dim x As Long
    Dim y As Long
    Dim lastrow As Long
    Dim lastcolumn As Long

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    lastcolumn = ActiveSheet.UsedRange.Column - 1 + ActiveSheet.UsedRange.Columns.Count
    lastrow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count

    For x = 2 To lastrow
        If Cells(x, 2).Value = "" Then
            Cells(x, 2).Value = Cells(x - 1, 2).Value
            Cells(x, 3).Value = Cells(x - 1, 3).Value
            Cells(x, 5).Value = Cells(x - 1, 5).Value
        End If
    Next x

    Application.ScreenUpdating = True

End Sub

With the above code My cells are being filled up, but the last row fills till the end of excel sheet. In the Excel sheet column D is already filled in Column B C & E should be auto fill to down. What should be the changes in the code?

Answer 1

Excel VBA Last Row: The Complete Tutorial To Finding The Last Row In Excel With VBA (And Code Examples) recommends using LookIn:=xlFormulas when determining the last with using Cells.Find .

lastrow = Find(What:=” * ”, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

Because you stated that column D is already filled in I use:

lastrow = Range("D" &  Rows.Count).End(xlUp).Row

If column E isn't filled in then Cells(x, 2).Value must be <> "" .

Sub AutoFill()
    Dim x As Long
    Dim y As Long
    Dim lastrow As Long
    Dim lastcolumn As Long
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    lastcolumn = ActiveSheet.UsedRange.Column - 1 + ActiveSheet.UsedRange.Columns.Count
    lastrow = Range("D" &  Rows.Count).End(xlUp).Row

    For x = 2 To lastrow

        If Cells(x, 2).Value = "" Then Cells(x, 2).Value = Cells(x - 1, 2).Value
        If Cells(x, 3).Value = "" Then Cells(x, 3).Value = Cells(x - 1, 3).Value
        If Cells(x, 5).Value = "" Then Cells(x, 5).Value = Cells(x - 1, 4).Value

    Next x
    Application.ScreenUpdating = True

End Sub