Sharing a VBA Autofill Macro I Made

So I've been working on my VBA skills and wrote a macro for autofilling (clicking the black box on the bottom right of a selected cell), because it always annoyed me that I could never find a way to efficiently do this without using the mouse. In the spirit of collaboration, I'd like to share it (see below).

How the macro works is that you can assign it to a keyboard shortcut and once you run it, it prompts you for a reference direction; then autofills to the same length you have as the data you have in the direction you chose. It works for series (1,2,3,4, or 5, 10, 15, 20), formulas, months, etc. For example, the numbers 1 through 1000 are in cells A1:A1000. the numbers 5 and 10 are in cells B1:B2. Highlight B1:B2, run macro, prompt left, and it will autofill in steps of 5 all the way down to B1000. Or, if a formula is in B1, it will autofill the formula.

The code is not the best since I haven't used descriptive variables but I did build in some error handling and overflow precautions so you don't accidentally wipe out a shitload of cells. Let me know if you find it useful, if you'd like additional functionality, if the code can be improved, etc.

To add the macro copy the code into a VBA module (Shift + F11, then alt + I + M). Assign the shortcut by viewing your macros. Put it in the personal macro workbook if you actually think you may use it.

The code:

Sub autofill()

On Error GoTo ErrHandler

Dim value As String Dim x As String Dim y As Single Dim z As String Dim w As Single

Start:

value = InputBox(prompt:="Enter your reference direction. Enter only [u,d,l,or r], short for up, down, left, or right.", Title:="Prompt")

Select Case StrPtr(value)

Case 0

    Exit Sub

Case Else

End Select

Select Case value

Case vbCancel

    Exit Sub

Case "u", "U", "up"

    x = ActiveCell.Address
    y = ActiveCell.Offset(-1, 0).End(xlToRight).Offset(1, 0).Row
    w = ActiveCell.Offset(-1, 0).End(xlToRight).Offset(1, 0).Column
    If y > 1000 Then Err.Raise 6
    If w > 1000 Then Err.Raise 6
    z = ActiveCell.Offset(-1, 0).End(xlToRight).Offset(1, 0).Address

    Selection.autofill Destination:=Range(x, z), Type:=xlFillDefault

Case "d", "D", "down"

    x = ActiveCell.Address
    y = ActiveCell.Offset(1, 0).End(xlToRight).Offset(-1, 0).Row
    w = ActiveCell.Offset(1, 0).End(xlToRight).Offset(-1, 0).Column
    If y > 1000 Then Err.Raise 6
    If w > 1000 Then Err.Raise 6
    z = ActiveCell.Offset(1, 0).End(xlToRight).Offset(-1, 0).Address

    Selection.autofill Destination:=Range(x, z), Type:=xlFillDefault

Case "l", "L", "left"

    x = ActiveCell.Address
    y = ActiveCell.Offset(0, -1).End(xlDown).Offset(0, 1).Row
    w = ActiveCell.Offset(0, -1).End(xlDown).Offset(0, 1).Column
    If y > 1000 Then Err.Raise 6
    If w > 1000 Then Err.Raise 6
    z = ActiveCell.Offset(0, -1).End(xlDown).Offset(0, 1).Address

    Selection.autofill Destination:=Range(x, z), Type:=xlFillDefault

Case "r", "R", "right"

    x = ActiveCell.Address
    y = ActiveCell.Offset(0, 1).End(xlDown).Offset(0, -1).Row
    w = ActiveCell.Offset(0, 1).End(xlDown).Offset(0, -1).Column
    If y > 1000 Then Err.Raise 6
    If w > 1000 Then Err.Raise 6
    z = ActiveCell.Offset(0, 1).End(xlDown).Offset(0, -1).Address

    Selection.autofill Destination:=Range(x, z), Type:=xlFillDefault

Case Else

    Dim invalid

    invalid = MsgBox(prompt:="Error: You have entered an invalid reference letter. Please retry or cancel.", Buttons:=vbRetryCancel + vbDefaultButton1 + vbExclamation)

    Select Case invalid

        Case vbRetry

            GoTo Start

        Case vbCancel

            Exit Sub

    End Select

End Select

Exit Sub

ErrHandler:

Dim ireply As Integer

If Err.Number = 6 Then

    ireply = MsgBox(prompt:="Error ""Overflow"" was generated. You may have referenced the wrong direction" _
    & " and/or are about to overwrite over 1,000 cells without the ability to undo. Are you sure you want to continue?", Buttons:=vbYesNo + vbExclamation + vbDefaultButton2, Title:="Warning!")

Select Case ireply

    Case vbYes

        Resume Next

    Case vbNo

        Exit Sub

End Select

Else: End If

ireply = MsgBox(prompt:="Error """ & Err.Description & """ was generated. You may want to check your reference direction." _
    & " Are you sure you wish to continue?", Buttons:=vbYesNo + vbExclamation + vbDefaultButton2, Title:="Warning")

Select Case ireply

    Case vbYes

        Resume Next

    Case vbNo

        Exit Sub

End Select

End Sub

5 Comments
 

looks like decent code to get the job done but may not be the most efficient.

You could also just use the keyboard by doing the following from the position you have:

Put "=A1+1" in A2 Put "=B1+5" in B2 Select A2 Ctrl + Down Arrow Ctrl + Right Arrow Ctrl + D Ctrl + C Ctrl + E S V

Might look like a lot but it takes about 5 seconds to do. (This also leaves you with undo options which is always better).

Good luck.

 
Best Response

Good macro. Just for fun, check this out, a little hacky but a simpler way to do almost the same thing and you don't have to specify direction, just select the cells you want to be autofilled (blanks and 2 with values) and run it (only works left to right or top to bottom though)

Sub Autofill() On Error Resume Next Right_Cell = Intersect(Selection.Cells(1, 2), Selection).Address Down_Cell = Intersect(Selection.Cells(2, 1), Selection).Address If Not IsEmpty(Right_Cell) Then Range(Selection.Cells(1, 1), Selection.Cells(1, 2)).Autofill Destination:=Selection, Type:=xlFillDefault ElseIf Not IsEmpty(Down_Cell) Then Range(Selection.Cells(1, 1), Selection.Cells(2, 1)).Autofill Destination:=Selection, Type:=xlFillDefault End If End Sub

 

Deserunt similique cum laudantium molestiae ut aspernatur fugiat. Voluptatibus deserunt aut temporibus nam blanditiis deleniti hic.

Asperiores et voluptas iusto molestiae eum. Qui rerum blanditiis minus velit. Ex omnis voluptatibus veritatis non fugiat fuga accusantium quia. Repudiandae laborum modi et enim quibusdam. Dolorem et ullam optio eaque qui. Sit delectus suscipit quia quo magni.

Career Advancement Opportunities

June 2026 Investment Banking

  • Evercore 01 99.4%
  • Moelis & Company 01 98.8%
  • JPMorgan 01 98.2%
  • Guggenheim Partners 01 97.7%
  • Morgan Stanley 07 97.1%

Overall Employee Satisfaction

June 2026 Investment Banking

  • Moelis & Company No 99.4%
  • Morgan Stanley 01 98.8%
  • Evercore 01 98.2%
  • BMO Capital Markets 12 97.6%
  • Banco Santander 01 97.1%

Professional Growth Opportunities

June 2026 Investment Banking

  • Moelis & Company No 99.4%
  • Evercore No 98.8%
  • Morgan Stanley 05 98.2%
  • JPMorgan No 97.7%
  • BMO Capital Markets 12 97.1%

Total Avg Compensation

June 2026 Investment Banking

  • Vice President (14) $434
  • Associates (43) $259
  • 3rd+ Year Analyst (8) $210
  • 2nd Year Analyst (22) $179
  • Intern/Summer Associate (13) $156
  • 1st Year Analyst (75) $151
  • Intern/Summer Analyst (66) $101
notes
16 IB Interviews Notes

“... there’s no excuse to not take advantage of the resources out there available to you. Best value for your $ are the...”

Leaderboard

success
From 10 rejections to 1 dream investment banking internship

“... I believe it was the single biggest reason why I ended up with an offer...”