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

 

[Blade Hunter]

Well you can do it dynamically.

In your formula, everywhere you have a specific row (Which I presume is the last row of data) Simply substitute the RowNum with " & Range("I" & Rows.Count).End(xlUp) & "

Then at runtime it will always make the formula go down to the last row of data.

Personally I actually do my calculations inside VBA and post to the sheet as a value rather than a formula. I do this to cut down on calculation time for the workbook and to reduce the size of the file (I pump out sales report that are in the order of 100K because everything is a simple text value). This keeps them small enough to email .

 

[Dummy Excel]

How can I do the formula in VB and display it as text as this report can range upto 100K lines also?

 

[Blade Hunter]

What does the formula currently return? Lets assume the data goes from E2:E12 What would your formula return to you?

 

[Dummy Excel]

the formula is like a match formula.

in column "I" is the year - there is 2006 2007 2008
in column "J" the formula is sum all qty's that is 2006 then under that total sum all qty's that is 2007 and then under that total sum all qty's that is 2008

something like the below:

raw data template.xlsx
	I	J	K	L
46534	Total2006	31912	33321	30838
46535	Total2007	47787	47168	44442
46536	Total2008	40600	40321	40692
Raw Data template (2)

hope that makes sense

 

[Dummy Excel]

sorry i forgot that this formula needs to be in columns J, K, L, M then a miss a column then the next 4 columns and miss 1, like what we did for the months previously

thanks
Sam

 

[Blade Hunter]

And what column does it tell me if it is 2006 / 2007 / 2008?

Cheers

D

 

[Blade Hunter]

I have done this part as a new subroutine. You will need to post it where we are looping through the columns. As soon as you insert the column, you would sum the existing one along the lines of this:

Call SumValue(X + 9 + (X * 4))

The Subroutine it is calling would be something like this:

Sub SumValue(ChosenColumn As Integer)
Dim MaxRow As Long
Dim SumValue(3) As Long
Dim X As Long
MaxRow = Range("J" & Rows.Count).End(xlUp)
SumValue(1) = 0
SumValue(2) = 0
SumValue(3) = 0
For X = 1 To MaxRow
    Select Case Range("J" & X).Value ' Change "J" to the columns where you expect the year to appear on each row
    Case 2006
        SumValue(1) = SumValue(1) + Cells(X, ChosenColumn).Value
    Case 2007
        SumValue(2) = SumValue(2) + Cells(X, ChosenColumn).Value
    Case 2008
        SumValue(3) = SumValue(3) + Cells(X, ChosenColumn).Value
    Case Else
        'Any code you want if there is neither 2006, 2007 or 2008
    End Select
Next
'You are now left with two values called SumValue(1) for 2006 and SumValue(2) for 2007 and SumValue(3) for 2008
'Post the values to where ever you like
For X = 1 To UBound(SumValue)
    Range("I" & Range("I" & Rows.Count).End(xlUp).Row).Offset(X + 1, 0).Formula = SumValue(X)
Next
End Sub

I have to work out of office for the rest of the day, see if you can get this working for you. If not I will try and help you out this evening.

Cheers

Dan

 

[Dummy Excel]

Hi Dan
for some reason it returns zeros 3 times - im guess one zero for each of the years

 

[Blade Hunter]

OK. Insert this line for me after each case statement:

debug.print ChosenColumn

If you don't already have the immediate window up, press CTRL-G after running the code. In that window you will have three values, I need to know what they are .

Thanks

Dan

 

[Dummy Excel]

morning Dan.
is this correct?

    Case 2006
        SumValue(1) = SumValue(1) + Cells(X, ChosenColumn)
        Debug.Print ChosenColumn

if so it didnt display anything