Loop through multiple columns, different formula in each column

[Twollaston]

Hey Everyone,

I have a spreadsheet that has 4 formulas in the last 4 columns at the end of the spreadsheet, it's an increasing spreadsheet(4900+ Rows increasing daily when refreshing a query) these formulas have been manually filled down, but I wanted to automate it into a macro since we already have a macro running on this spreadsheet for other things.

I first started out with this code, but the problem is, if all the formulas are already filled down completely, then it will just copy the headers all the way to the end. So it will only work if there are blanks at the end.

Range("AA2").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Range("A1.D1").Select
Range(Selection, Selection.End(xlUp)).Select
Selection.Filldown

I was thinking about just having the headers deleted before this portion of the macro runs and then just add them back at the end of the macro so the fill will only catch the formulas even if it's full, but the headers are protected and can't be changed.

Then I just changed it to a loop for each column starting in row 2, but it was taking a really long time. I'm guessing there is a way better way to loop to speed it up, but I was wondering if someone had a solution for this that doesn't take so long to run (it's going to run through around 20,000 rows and get bigger slowly over time.)

Sub DDFill()

Dim lRow As Long


lRow = Cells(Rows.Count, 1).End(xlUp).Row


Application.ScreenUpdating = False

    Range("AB2").Select
    Do Until ActiveCell.Row = lRow + 1
    ActiveCell.FormulaR1C1 = "=IF(RC[-9]=""1/1/0001"","" "",DATEVALUE(RC[-9]))"
    ActiveCell.Offset(1, 0).Range("A1").Select
    Loop
    
    Range("AC2").Select
    Do Until ActiveCell.Row = lRow + 1
    ActiveCell.FormulaR1C1 = "=IF(RC[-8]="" "", "" "",DATEVALUE(RC[-8]))"
    ActiveCell.Offset(1, 0).Range("A1").Select
    Loop
     
    Range("AD2").Select
    Do Until ActiveCell.Row = lRow + 1
    ActiveCell.FormulaR1C1 = "=IF(RC[-7]="" "", "" "",DATEVALUE(RC[-7]))"
    ActiveCell.Offset(1, 0).Range("A1").Select
    Loop
    
    Range("AE2").Select
    Do Until ActiveCell.Row = lRow + 1
    ActiveCell.FormulaR1C1 = "=MID(RC[-21],1,5)"
    ActiveCell.Offset(1, 0).Range("A1").Select
    Loop

Application.ScreenUpdating = True
    
End Sub

 

[Fluff]

Try it like

   lRow = Cells(Rows.Count, 1).End(xlUp).Row

   Range("AB2:AB" & LastRow).FormulaR1C1 = "=IF(RC[-9]=""1/1/0001"","" "",DATEVALUE(RC[-9]))"
   Range("AC2:AC" & LastRow).FormulaR1C1 = "=IF(RC[-8]="" "", "" "",DATEVALUE(RC[-8]))"

 

[Twollaston]

Try it like

   lRow = Cells(Rows.Count, 1).End(xlUp).Row

   Range("AB2:AB" & LastRow).FormulaR1C1 = "=IF(RC[-9]=""1/1/0001"","" "",DATEVALUE(RC[-9]))"
   Range("AC2:AC" & LastRow).FormulaR1C1 = "=IF(RC[-8]="" "", "" "",DATEVALUE(RC[-8]))"

A++
Thank you, that works a lot better than what I had and it's so fast!
Have a great day sir

 

[Fluff]

You're welcome & thanks for the feedback