How can I make this run faster?

[Dummy Excel]

HI All,
My data can vary from 40k rows to 100k rows (im using xl07) - Can someone help me to speed up the macro?

my code is:

    'Formatting APN
    Columns("C:C").Select
    Selection.NumberFormat = "0"
    Range("A1").Select
    
    'Creating Style Colour column
    Columns("H:H").Select
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "Style Colour"
    Range("H2").Select
    ActiveCell.FormulaR1C1 = "=RC[-4]&RC[-3]"
    Range("H2").Select
    Selection.Copy
    Range("G2").End(xlDown).Offset(0, 1).Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    'Creating SKU column
    Range("I1").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "SKU"
    Range("I2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-3]=""N/A"",RC[-5]&RC[-4]&RC[-2],IF(RC[-2]=""N/A"",RC[-5]&RC[-4]&RC[-3],RC[-5]&RC[-4]&RC[-3]&RC[-2]))"
    Range("I2").Select
    Selection.Copy
    Range("h2").End(xlDown).Offset(0, 1).Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    
    'creating total at end
    Range("DL1").Select
    ActiveCell.FormulaR1C1 = "Total"
    With ActiveCell.Characters(Start:=1, Length:=5).Font
        .Name = "Arial"
        .FontStyle = "Regular"
        .Size = 10
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Range("DL2").Select
    ActiveCell.FormulaR1C1 = "=SUM(RC[-52]:RC[-1])"
    Range("DL2").Select
    Selection.Copy
    Range("DK1").End(xlDown).Offset(0, 1).Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    
    'sets autofilter
    Range("a1").Select
    Selection.AutoFilter
    Range("a1").Select
    
    'adds columns for months - first year
    Columns("P:P").Select
    Selection.Insert Shift:=xlToRight
    Range("P1").Select
    ActiveCell.FormulaR1C1 = "Jan"
    Columns("U:U").Select
    Selection.Insert Shift:=xlToRight
    Range("U1").Select
    ActiveCell.FormulaR1C1 = "Feb"
    Columns("Z:Z").Select
    Selection.Insert Shift:=xlToRight
    Range("Z1").Select
    ActiveCell.FormulaR1C1 = "Mar"
    Columns("AE:AE").Select
    Selection.Insert Shift:=xlToRight
    Range("AE1").Select
    ActiveCell.FormulaR1C1 = "Apr"
    Columns("AJ:AJ").Select
    Selection.Insert Shift:=xlToRight
    Range("AJ1").Select
    ActiveCell.FormulaR1C1 = "May"
    Columns("AO:AO").Select
    Selection.Insert Shift:=xlToRight
    Range("AO1").Select
    ActiveCell.FormulaR1C1 = "Jun"
    Columns("AT:AT").Select
    Selection.Insert Shift:=xlToRight
    Range("AT1").Select
    ActiveCell.FormulaR1C1 = "Jul"
    Columns("AY:AY").Select
    Selection.Insert Shift:=xlToRight
    Range("AY1").Select
    ActiveCell.FormulaR1C1 = "Aug"
    Columns("BD:BD").Select
    Selection.Insert Shift:=xlToRight
    Range("BD1").Select
    ActiveCell.FormulaR1C1 = "Sep"
    Columns("BI:BI").Select
    Selection.Insert Shift:=xlToRight
    Range("BI1").Select
    ActiveCell.FormulaR1C1 = "Oct"
    Columns("BN:BN").Select
    Selection.Insert Shift:=xlToRight
    Range("BN1").Select
    ActiveCell.FormulaR1C1 = "Nov"
    Columns("BS:BS").Select
    Selection.Insert Shift:=xlToRight
    Range("BS1").Select
    ActiveCell.FormulaR1C1 = "Dec"
    Columns("BX:BX").Select
    Selection.Insert Shift:=xlToRight
    
    'second year
    Columns("CC:CC").Select
    Selection.Insert Shift:=xlToRight
    Range("CC1").Select
    ActiveCell.FormulaR1C1 = "Jan"
    Columns("CH:CH").Select
    Selection.Insert Shift:=xlToRight
    Range("CH1").Select
    ActiveCell.FormulaR1C1 = "Feb"
    Columns("CM:CM").Select
    Selection.Insert Shift:=xlToRight
    Range("CM1").Select
    ActiveCell.FormulaR1C1 = "Mar"
    Columns("CR:CR").Select
    Selection.Insert Shift:=xlToRight
    Range("CR1").Select
    ActiveCell.FormulaR1C1 = "Apr"
    Columns("CW:CW").Select
    Selection.Insert Shift:=xlToRight
    Range("CW1").Select
    ActiveCell.FormulaR1C1 = "May"
    Columns("DB:DB").Select
    Selection.Insert Shift:=xlToRight
    Range("DB1").Select
    ActiveCell.FormulaR1C1 = "Jun"
    Columns("DG:DG").Select
    Selection.Insert Shift:=xlToRight
    Range("DG1").Select
    ActiveCell.FormulaR1C1 = "Jul"
    Columns("DL:DL").Select
    Selection.Insert Shift:=xlToRight
    Range("DL1").Select
    ActiveCell.FormulaR1C1 = "Aug"
    Columns("DQ:DQ").Select
    Selection.Insert Shift:=xlToRight
    Range("DQ1").Select
    ActiveCell.FormulaR1C1 = "Sep"
    Columns("DV:DV").Select
    Selection.Insert Shift:=xlToRight
    Range("DV1").Select
    ActiveCell.FormulaR1C1 = "Oct"
    Columns("EA:EA").Select
    Selection.Insert Shift:=xlToRight
    Range("EA1").Select
    ActiveCell.FormulaR1C1 = "Nov"
    Columns("EF:EF").Select
    Selection.Insert Shift:=xlToRight
    Range("EF1").Select
    ActiveCell.FormulaR1C1 = "Dec"

End Sub

thanks
Sam

 

[supdawg]

What takes so long, calculating the formulas?

I see a lot of selecting there, you almost dont have to ever select a range to work with it. Not sure that would help speed things along though.

 

[Blade Hunter]

Remove the selects and selections.

Example:

    Range("DL2").Select
    Selection.Copy

becomes

    Range("DL2").Copy

Do this throughout all the code and it will have a massive impact.

Also because the formulas are calculating each time you change a cell, put this at the start:

Application.Calculation = xlCalculationManual

And this at the end:

Application.Calculation = xlCalculationAutomatic

 

[zzjasonzz]

in addition to that try adding at the beginning :

application.screenupdating = false

and this at the end

application.screenupdating = true

 

[Dummy Excel]

Thanks guys
is there a better way to do all the inserting of a new column? A new column needs to be added for every fourth columns (for each week in a month)?

 

[Blade Hunter]

You could use something along the lines of:

Dim MonthName As Variant
MonthName = Array("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")
For X = 1 To 12
    Cells(2, X + 11 + (X * 4)).Formula = MonthName(X - 1)
    Cells(2, X + 76 + (X * 4)).Formula = MonthName(X - 1)
Next

this puts the months in the same places your code did but without seeing the sheet or the codes application I am just guessing what you need it to do.

Can you post some sample data?

Cheers

Dan

 

[zzjasonzz]

you could try

j = 1
For i = 1 To 140 Step 5
    Columns(i).Insert Shift:=xlToRight
    Cells(1, i) = Left(MonthName(j), 3)
    j = j + 1
    If j = 13 Then
        j = 1
        i = i + 5
    End If
Next i

 

[Blade Hunter]

Actually, even better, drop the array altogether:

Sub Temp()
For X = 1 To 12
    Cells(2, X + 11 + (X * 4)).Formula = Format("1/" & X & "/08", "Mmm")
    Cells(2, X + 76 + (X * 4)).Formula = Format("1/" & X & "/08", "Mmm")
Next
End Sub

Note, if you are in the US this will probably need to be changed round to account for your date settings.

 

[Blade Hunter]

I would also reccomend you don't put a sum column all the way down to row 65,536. Can you anticipate how many rows of data there will be?

 

[Dummy Excel]

zzjasonzz - your way does work, although it actually places jan/feb in row 2 of the data, it actually doesnt insert a new row.

BH - your second post results the same way as zzjasonzz

To answer your question BH, I was going to use the xldown function with an offset to find the last cell and do the total that way - Is there a better way?

thanks both for your patience