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]

morning Dan.
is this correct?

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

if so it didnt display anything

That is correct.

OK, Try this:

For X = 1 To 12
    Columns(X + 9 + (X * 4)).Insert Shift:=xlToRight
    dubug.print (X + 9 + (X * 4))
    Cells(1, X + 9 + (X * 4)).Formula = Format("1/" & X & "/08", "Mmm")
    Columns((X * 2) + 57 + (X * 4)).Insert Shift:=xlToRight
    Cells(1, (X * 2) + 57 + (X * 4)).Formula = Format("1/" & X & "/08", "Mmm")
Next

So we are putting a debug.print straight after the column insert.

What we are trying to do here is work out where exactly the code is dropping the result. You can see how what I am trying to do works by doing the following:

Sub xyz()
Call zyx(1)
End Sub
 
Sub zyx(ChosenColumn As Integer)
Debug.Print ChosenColumn
End Sub

and stepping through xyz

Hehehe, remote Debugging, this has to be a first for me

Cheers

Dan

 

[Dummy Excel]

I think im doing it right...it doesnt like

dubug.Print (X + 9 + (X * 4))

 

[Blade Hunter]

Sorry, my mistake, I made a typo, Dubug.Print should be Debug.Print.

 

[Dummy Excel]

ok
it adds the months in correctly, although there is no sign of the totals

 

[Blade Hunter]

OK, So lets recap. It calculates the column correctly but it ISN'T sending it to the macro we are the calling correct? or is it sending to the macro correctly but not understanding something in the called sub?

 

[Blade Hunter]

OK. Can you tell me what appears in Column J? Like copy and past say 10 rows of data from somewhere in Column J.

I have a sneaking suspision that your Years appear in Column I not J.

Check the comments in the post where I put the code in for you/

Select Case Range("J" & X).Value ' Change "J" to the columns where you expect the year to appear on each row

We need to make sure that we change the J to the column where you expect the year to appear.

Cheers

Dan

 

[Dummy Excel]

sorry Dan,
Can we take one step back - Should my code look like this?

Sub test()

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

End Sub

Sub SumValue(ChosenColumn As Integer)
Dim MaxRow As Long
Dim SumValue(3) As Long
Dim X As Long

For X = 1 To 13
    Columns(X + 9 + (X * 4)).Insert Shift:=xlToRight
    Debug.Print (X + 9 + (X * 4))
    Cells(1, X + 9 + (X * 4)).Formula = Format("1/" & X & "/08", "Mmm")
    Columns((X * 2) + 57 + (X * 4)).Insert Shift:=xlToRight
    Cells(1, (X * 2) + 57 + (X * 4)).Formula = Format("1/" & X & "/08", "Mmm")
Next

MaxRow = Range("i" & Rows.Count).End(xlUp)
SumValue(1) = 0
SumValue(2) = 0
SumValue(3) = 0
For X = 1 To MaxRow
    Select Case Range("I" & 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)
        Debug.Print ChosenColumn
    Case 2007
        SumValue(2) = SumValue(2) + Cells(X, ChosenColumn)
        Debug.Print ChosenColumn
    Case 2008
        SumValue(3) = SumValue(3) + Cells(X, ChosenColumn)
        Debug.Print ChosenColumn
    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("J" & Range("J" & Rows.Count).End(xlUp).Row).Offset(X + 1, 0).Formula = SumValue(X)
'Next
End Sub

 

[Dummy Excel]

here is my code;

raw data template.xlsx
	I	J	K	L
1	IHYEAR	IHSH01	IHSH02	IHSH03
2	2006	0	0	0
3	2006	2	2	2
4	2006	2	2	2
5	2006	3	3	3
6	2006	3	3	3
7	2006	3	3	3
Raw Data template (2)

keep in mind that the year has 2006, 2007, & 2008

 

[Blade Hunter]

Nope. The SumValue sub should be exactly as I posted before.

This part:

For X = 1 To 13
    Columns(X + 9 + (X * 4)).Insert Shift:=xlToRight
    Debug.Print (X + 9 + (X * 4))
    Cells(1, X + 9 + (X * 4)).Formula = Format("1/" & X & "/08", "Mmm")
    Columns((X * 2) + 57 + (X * 4)).Insert Shift:=xlToRight
    Cells(1, (X * 2) + 57 + (X * 4)).Formula = Format("1/" & X & "/08", "Mmm")
Next

Belongs in your original macro.

This part

Debug.Print (X + 9 + (X * 4))

Can now be changed to Call SumValue(X + 9 + (X * 4)) as we have proven that it submits the value. This change is in your other subroutine, NOT the one called SumValue.

If this data is not sensative, I am happy to fix it for you if you can get it to me.

 

[Dummy Excel]

im confussed - which isnt hard to do sometimes!

If you can PM me your email address I will send you sample data

Really appreciate your time and effort
Sam