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

 

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

 

Sequi dicta nesciunt ipsum nesciunt. Voluptatem voluptatem et impedit. Magni qui minus natus.

Career Advancement Opportunities

April 2024 Investment Banking

  • Jefferies & Company 02 99.4%
  • Goldman Sachs 19 98.8%
  • Harris Williams & Co. New 98.3%
  • Lazard Freres 02 97.7%
  • JPMorgan Chase 03 97.1%

Overall Employee Satisfaction

April 2024 Investment Banking

  • Harris Williams & Co. 18 99.4%
  • JPMorgan Chase 10 98.8%
  • Lazard Freres 05 98.3%
  • Morgan Stanley 07 97.7%
  • William Blair 03 97.1%

Professional Growth Opportunities

April 2024 Investment Banking

  • Lazard Freres 01 99.4%
  • Jefferies & Company 02 98.8%
  • Goldman Sachs 17 98.3%
  • Moelis & Company 07 97.7%
  • JPMorgan Chase 05 97.1%

Total Avg Compensation

April 2024 Investment Banking

  • Director/MD (5) $648
  • Vice President (19) $385
  • Associates (86) $261
  • 3rd+ Year Analyst (14) $181
  • Intern/Summer Associate (33) $170
  • 2nd Year Analyst (66) $168
  • 1st Year Analyst (205) $159
  • Intern/Summer Analyst (145) $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

1
redever's picture
redever
99.2
2
Secyh62's picture
Secyh62
99.0
3
Betsy Massar's picture
Betsy Massar
99.0
4
BankonBanking's picture
BankonBanking
99.0
5
CompBanker's picture
CompBanker
98.9
6
dosk17's picture
dosk17
98.9
7
kanon's picture
kanon
98.9
8
GameTheory's picture
GameTheory
98.9
9
bolo up's picture
bolo up
98.8
10
Linda Abraham's picture
Linda Abraham
98.8
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...”