AutoFill down non contigous Columns

[Rikkdh]

Me again...

I'm having performance issues running a series of macros that perform calculations on worksheets (20 of them).

Each calculation is the same and runs on each of the worksheets, the worksheets have the same columns but the column length varies hugely, some have 20 rows, some have 40K+. The columns are non contigous so right now I have fixed the length of the range to 50,000 to ensure that the formulas copy down and that there are no breaks when it fills down, but even this isn't working as i'm getting range errors and its taking what feels like years to run!

Can anyone suggest a smarter, more efficient way of doing this...

I've attached some code samples below:

Sub Prep_Report_Data()
Dim ws As Worksheet

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    For Each ws In ThisWorkbook.Worksheets

         If ws.Name <> "Control" And ws.Name <> "SH1" And ws.Name <> "Sh2" And ws.Name <> "Sh3" And ws.Name <> _
        "Sh4" And ws.Name <> "Sh5" And ws.Name <> "Sh6" And ws.Name <> "Sh7" And ws.Name <> _
        "Sh8" And ws.Name <> "Sh9" And ws.Name <> "Sh10" And ws.Name <> "Sh11" _
        And ws.Name <> "Sh12" And ws.Name <> "Sh13" And ws.Name <> "Sh14" And ws.Name <> "Sh15" And ws.Name <> "Sh16" _
        And ws.Name <> "Sh17" And ws.Name <> "Sh19" And ws.Name <> "Sh20" And ws.Name <> "Sh21" Then


Call Date_Left10(ws)
Call Date_Value(ws)
Call Aged_Calc(ws)
Call Concat_Date_Type(ws)
Call Concat_Date_Status(ws)
Call Age_Result(ws)
End If

    Next ws

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Sub

Sub Date_Left10(ws As Worksheet)
'
' Date_Left10 Macro
'

ws.Activate
    Range("AA2").Select
    ActiveCell.FormulaR1C1 = "=LEFT(RC[-22],10)"
    Selection.Copy
    Range("AA3").Select
    Selection.AutoFill Destination:=Range("AA3:AA50000")
    Range("AA3:AA50000").Select
    Range("AA1").Select
    
    
End Sub

Sub Date_Value(ws As Worksheet)
'
' Date_Value Macro
'

ws.Activate
    Range("Ab2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=LEFT(RC[-1],5)"
    Range("AB2").Select
    Selection.Copy
    Range("AB3").Select
    Selection.AutoFill Destination:=Range("AB3:AB50000")
    Range("AB3:AB50000").Select
    Range("AB1").Select
    
    'Range(Selection, Selection.End(xlDown)).Select
    'ActiveSheet.Paste
    'Range("A2").Select
End Sub

Sub Aged_Calc(ws As Worksheet)
'
' Aged_Calc Macro
'
ws.Activate
    Range("AC2").Select
    ActiveCell.FormulaR1C1 = "=IF(ISERROR(RC[-15]-RC[-1]),"""",(RC[-15]-RC[-1]))"
    Range("AC2").Select
    Selection.AutoFill Destination:=Range("AC2:AC50000")
    Range("AC2:AC50000").Select
End Sub

Sub Concat_Date_Type(ws As Worksheet)
'
' Concat_Date_Type Macro
'

ws.Activate
    Range("AD2").Select
    ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-2],RC[-29])"
    Range("AD2").Select
    Selection.AutoFill Destination:=Range("AD2:AD50000")
    Range("AD2:AD50000").Select
    Range("AD1").Select
End Sub

Sub Concat_Date_Status(ws As Worksheet)
'
' Concat_Date_Status Macro
'
ws.Activate
    Range("AE2").Select
    ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-3],RC[-19])"
    Range("AE2").Select
    Selection.AutoFill Destination:=Range("AE2:AE50000")
    Range("AE2:AE50000").Select
    Range("AE1").Select
End Sub

Sub Age_Result(ws As Worksheet)
'
' Age_Result Macro
'
ws.Activate
    Range("AF2").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-3]<0,0,RC[-3])"
    Range("AF2").Select
    Selection.AutoFill Destination:=Range("AF2:AF50000")
    Range("AF2:AF50000").Select
    Range("AF1").Select
End Sub

[ragulduy]

Well you could try something like

Sub Age_Result
  ws.Range("AF2:AF50000").formulaR1C1 = "=IF(RC[-3]<0,0,RC[-3])"
End Sub

Probably don't really need all the separate modules either:

Sub Prep_Report_Data()
Dim ws As Worksheet

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    For Each ws In ThisWorkbook.Worksheets

         If ws.Name <> "Control" And ws.Name <> "SH1" And ws.Name <> "Sh2" And ws.Name <> "Sh3" And ws.Name <> _
        "Sh4" And ws.Name <> "Sh5" And ws.Name <> "Sh6" And ws.Name <> "Sh7" And ws.Name <> _
        "Sh8" And ws.Name <> "Sh9" And ws.Name <> "Sh10" And ws.Name <> "Sh11" _
        And ws.Name <> "Sh12" And ws.Name <> "Sh13" And ws.Name <> "Sh14" And ws.Name <> "Sh15" And ws.Name <> "Sh16" _
        And ws.Name <> "Sh17" And ws.Name <> "Sh19" And ws.Name <> "Sh20" And ws.Name <> "Sh21" Then


ws.Range("AA2:AA50000").FormulaR1C1 = "=LEFT(RC[-22],10)"
ws.Range("AB2:AB50000").FormulaR1C1 = "=LEFT(RC[-1],5)"
ws.Range("AC2:AC50000").FormulaR1C1 = "=IF(ISERROR(RC[-15]-RC[-1]),"""",(RC[-15]-RC[-1]))"
ws.Range("AD2:AD50000").FormulaR1C1 = "=CONCATENATE(RC[-2],RC[-29])"
ws.Range("AE2:AE50000").FormulaR1C1 = "=CONCATENATE(RC[-3],RC[-19])"
ws.Range("AF2:AF50000").FormulaR1C1 = "=IF(RC[-3]<0,0,RC[-3])"

End If

    Next ws

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Sub

[Rikkdh]

Cheers yudlugar...worked a treat, nice and simple too, just how we like it Nice and efficient...