multiple Down-Fill formulas, not values...

[omairhe]

Hey everyone,

I recently was in need of a procedure where multiple headings required filling down. Kind of like

From this
Bean
""
""
Axel
""
Frog
""
""
""

To this
Bean
Bean
Bean
Axel
Axel
Frog
Frog
Frog
Frog

an easy way of doing it was selecting the column and using F5 key; selecting blanks and Ctrl + Enter. This works great with values, however, with formulas its a different story. What might be a solution here if I needed to copy/fill down formulas multiple times for each formula based heading.

Thanks and will appreciate.

 

[omairhe]

Sub COPY_HEADER()

Application.ScreenUpdating = False
Application.EnableEvents = False

    For my_rows = 2 To Range("C" & Rows.Count).End(xlUp).Row 'C2 is the starting cell reference

        If IsEmpty(Range("C" & my_rows)) Then
            
            Range("C" & my_rows - 1).Copy
            Range("C" & my_rows).PasteSpecial (xlPasteFormulas)
        
        End If

    Next my_rows

Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub

The above code copy pastes the formula in column C but it takes a while to do this, as I am working with more than 50,000 rows. Can it be made more efficient please, or is this the best that vba has to offer?

 

[omairhe]

Not a very elegant way of doing this but this will do the job for now..

Sub Copy_Formula_Headers()
'please select last cell from below of your desired column before running this macro
On Error GoTo errhandler
Application.ScreenUpdating = False
Dim I
For I = 1 To 1000000 'max number of possible filldowns
    If IsEmpty(ActiveCell.Value) Then
    ActiveCell.Offset().Range("A1").Select
    Range(Selection, Selection.End(xlUp)).Select
    Selection.FillDown
    Else
    ActiveCell.Offset(1, 0).Range("A1").Select
    Selection.End(xlUp).Select
    ActiveCell.Offset(-1, 0).Range("A1").Select
    End If
Next I
Application.ScreenUpdating = True
errhandler: Exit Sub
End Sub

 

[omairhe]

For the record, if someone is looking for something similar and working with 1000s of rows that need formulas to be copied down, I reckon disabling the auto calculations temporarily. It will do the job in mere seconds. this version of the code will disable calculations temporarily until the procedure ends .

Sub Copy_Formula_Headers()
'please select last cell from below of your desired column before running this macro
On Error GoTo errhandler
Application.Calculation = xlManual
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim I
For I = 1 To 10000000 'max number of possible filldowns (please do not change)
    If IsEmpty(ActiveCell.Value) Then
    ActiveCell.Offset().Range("A1").Select
    Range(Selection, Selection.End(xlUp)).Select
    Selection.FillDown
    Else
    ActiveCell.Offset(1, 0).Range("A1").Select
    Selection.End(xlUp).Select
    ActiveCell.Offset(-1, 0).Range("A1").Select
    End If
Next I
Application.EnableEvents = True
Application.ScreenUpdating = True
errhandler:
Application.Calculation = xlAutomatic
Exit Sub
End Sub