asked on

VBA Excel: fill down formulas automatically

Hello experts, I found the following excellent procedure:

Sub FormulaFill()
    Dim cel As Range, rg As Range
    Dim lastrow As Long
    lastrow = Range("A" & Rows.Count).End(xlUp).Row
    If lastrow < 2 Then Exit Sub
    
    Application.ScreenUpdating = False
    
    Set rg = Range("A2:AZ" & lastrow)
    For Each cel In rg.Rows(1).Cells
        If cel.HasFormula Then
            cel.Copy
            Intersect(cel.EntireColumn, rg).PasteSpecial xlPasteFormulas
        End If
    Next
    Range("A1").Select

End Sub

Open in new window

I would like to adapt the code by adding the following requirement:

1-Be able to place a formula in the cell that I want ex: A5 and fill down the formula till the last row of a reported column.

Ex: I place a formula in A5.
When I launch the procedure I should have:

1-An input box asking "Select or report the range location of your formula?". Activecell by default.
2-An input box asking "Select or report your last column in which you want to paste your formula?", remark: I should be able to select the same column letter in which is located my formula.
3-The procedure should paste the formula as of the range of my formula to the reported column & last used row.

The idea is to add this procedure to my Personal.xlsb so we can use Activesheet as worksheet.

Thank you again for your help.

Ryan Chong

I use this sub to paste the formulas:

Sub FormulaFill(Optional ByVal CellLocation As String)
    Dim cel As Range, rg As Range
    Dim lastrow As Long
    
    If CellLocation = "" Then
        lastrow = Range(Replace(ActiveCell.Address, Range(ActiveCell.Address).Row, "") & Rows.Count).End(xlUp).Row
        Set rg = Range(ActiveCell.Address, Replace(ActiveCell.Address, Range(ActiveCell.Address).Row, "") & lastrow)
    Else
        lastrow = Range(Replace(Range(CellLocation).Address, Range(CellLocation).Row, "") & Rows.Count).End(xlUp).Row
        Set rg = Range(CellLocation, Replace(Range(CellLocation).Address, Range(CellLocation).Row, "") & lastrow)
    End If
    
    If lastrow < 2 Then Exit Sub
    
    Application.ScreenUpdating = False
    
    
    If rg.Rows(1).Columns(1).HasFormula Then
        rg.Rows(1).Columns(1).Copy
        rg.PasteSpecial xlPasteFormulas
    End If
    
    Application.ScreenUpdating = True
    
End Sub

Open in new window

then idea is calling this sub when:

1. To specify a cell, use:

Call FormulaFill("A5")

Open in new window

2. To use active cell, use:

Call FormulaFill

Open in new window

Luis Diaz

ASKER

Thank you for this proposal.

I tested your code by selecting my formula in C1, however I don't have the filldownformula applied for the formula.

Please find attached my test.

Thank you again for your help.
FormulaFill_41020897.xlsm

ASKER CERTIFIED SOLUTION

Ryan Chong

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Luis Diaz

ASKER

Thank you it works perfectly.

I have a question, instead of using private sub as I want to add this in my PERSONAL.xlsb in order to call the macro in no matter worksheet that I want should I change Private Sub to Sub?

Ryan Chong

>>I want to add this in my PERSONAL.xlsb in order to call the macro in no matter worksheet that I want should I change Private Sub to Sub?

You can declare it as Public Sub instead.

Luis Diaz

ASKER

Pefect. Thank you for your help.

Luis Diaz

ASKER

Thank you again for your help.