Search code examples
vbaexceleventtrigger

trigger filldown formula based on cell of another worksheet


I have four worksheets and I write one formula in cell F2 which trigger a filldown for all the rest. I already have the trigger private sub to call my procedure that works. Is there a way to make this sub more efficient?

Option Explicit

Sub FillDownFormula_test2()
 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 ' Filldown a formula for in column of data.
 ' Assumes a data table with headings in the first row,
 ' the formula in the second row and is the active cell.
 ' this one is tested based on set range
 ' Test results were positive
 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 Dim rng As Range, rng2 As Range
 Dim rngData As Range
 Dim rngFormula As Range, rng2Formula As Range
 Dim rowData As Long
 Dim colData As Long
 Dim wb As Workbook: Set wb = ThisWorkbook
 Dim ws As Worksheet, ws2 As Worksheet

 Set ws = wb.Sheets("Feuil1")


 With ws

' Set the ranges
 Set rng = wb.Sheets("Feuil1").Range("F2")
 Set rngData = rng.CurrentRegion

' Set the row and column variables
 rowData = rngData.CurrentRegion.Rows.Count
 colData = rng.Column

' Set the formula range and fill down the formula
 Set rngFormula = rngData.Offset(1, colData - 1).Resize(rowData - 1, 1)
 rngFormula.FillDown

 'G2 is a different formulas but same on every sheets
 Set rng2 = wb.Sheets("Feuil1").Range("G2")


' Set the row and column variables
 rowData = rngData.CurrentRegion.Rows.Count
 colData = rng2.Column

' Set the formula range and fill down the formula
 Set rng2Formula = rngData.Offset(1, colData - 1).Resize(rowData - 1, 1)
 rng2Formula.FillDown
 End With



 With ws2
Set rng = wb.Sheets("Feuil2").Range("F2")
 Set rngData = rng.CurrentRegion

' Set the row and column variables
    rowData = rngData.CurrentRegion.Rows.Count
   colData = rng.Column

' Set the formula range and fill down the formula
 Set rngFormula = rngData.Offset(1, colData - 1).Resize(rowData - 1, 1)
 rngFormula.FillDown

 Set rng2 = wb.Sheets("Feuil2").Range("G2")


' Set the row and column variables
 rowData = rngData.CurrentRegion.Rows.Count
 colData = rng2.Column

' Set the formula range and fill down the formula
 Set rng2Formula = rngData.Offset(1, colData - 1).Resize(rowData - 1, 1)
     rng2Formula.FillDown



 End With
 End Sub

One last question: what would've been the most efficient to do one range at the time so it allows me to enter formula before doing the second one. ( I have six formulas to filldown)

thank you


Solution

  • It could look something like this...

    Option Explicit
    
    Sub FillDownFormula_test2()
     '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
     ' Filldown a formula for in column of data.
     ' Assumes a data table with headings in the first row,
     ' the formula in the second row and is the active cell.
     ' this one is tested based on set range
     ' Test results were positive
     '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        Dim wb As Workbook
        Set wb = ActiveWorkbook
    
        Dim ws As Worksheet
        Dim ws2 As Worksheet
    
        Set ws = wb.Sheets("Feuil1")
    
        With ws
            Call FillDownData(.Range("F2"), Range("F2").CurrentRegion)
            Call FillDownData(.Range("G2"), Range("G2").CurrentRegion)
        End With
    
        Set ws2 = wb.Sheets("Feuil2")
    
        With ws2
            Call FillDownData(.Range("F2"), Range("F2").CurrentRegion)
            Call FillDownData(.Range("G2"), Range("G2").CurrentRegion)
        End With
    
    End Sub
    
    Function FillDownData(rng As Range, rngData As Range)
    
        Dim rowData As Long
        Dim colData As Long
        Dim rngFormula As Range
    
    ' Set the row and column variables
        rowData = rngData.CurrentRegion.Rows.Count
        colData = rng.column
    Debug.Print rowData & " " & colData
    ' Set the formula range and fill down the formula
        'Set rngFormula = rngData.Offset(1, colData - 1).Resize(rowData - 1, 1)
        'rngFormula.FillDown
    
    End Function