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.
Tried it out, pretty cool. I changed the u d l r to 1 2 3 4 for faster usage but I'll try using it going forward thanks
Automatic like for the spirit of collaboration.
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.
See All Comments - 100% Free
WSO depends on everyone being able to pitch in when they know something. Unlock with your email and get bonus: 6 financial modeling lessons free ($199 value)
or Unlock with your social account...