Macro Running faster

S

SWF13

New Member
Joined
Apr 7, 2011
Messages
5
Hello,

I'm new to writing macros and i need to run a report which takes a large amount of data and presents it on a form. Ive used pivot tables and lookups but the macro takes a long time to run. Could anyone help in making my code a bit sleeker?

Sub Intorducer()<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /><o:p></o:p>
'<o:p></o:p>
' Intorducer Macro<o:p></o:p>
'<o:p></o:p>
Columns("B:C").Select<o:p></o:p>
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove<o:p></o:p>
Range("B1").Select<o:p></o:p>
Range("B1", Range("A65536").End(xlUp).Offset(, 1)).Formula = "=Left(A1,5)"<o:p></o:p>
Range("C2").Select<o:p></o:p>
Range("C2", Range("B65536").End(xlUp).Offset(, 1)).Formula = "=If(B2>0,vlookup(B2,'Date Table'!A:B,2,))"<o:p></o:p>
Range("C1").Select<o:p></o:p>
ActiveCell.FormulaR1C1 = "DATE"<o:p></o:p>
Columns("C:C").Select<o:p></o:p>
Selection.NumberFormat = "mmm/yy"<o:p></o:p>
Range("B1").Select<o:p></o:p>
ActiveCell.FormulaR1C1 = "VALUE"<o:p></o:p>
Range("B:B").Select<o:p></o:p>
With Selection<o:p></o:p>
Selection.NumberFormat = "General"<o:p></o:p>
.Value = .Value<o:p></o:p>
End With<o:p></o:p>
Columns("I:J").Select<o:p></o:p>
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove<o:p></o:p>
Range("I1").Select<o:p></o:p>
Range("I1", Range("H65536").End(xlUp).Offset(, 1)).Formula = "=Left(H1,5)"<o:p></o:p>
Range("J2").Select<o:p></o:p>
Range("J2", Range("I65536").End(xlUp).Offset(, 1)).Formula = "=If(I2>0,vlookup(I2,'Date Table'!A:B,2,))"<o:p></o:p>
Range("J1").Select<o:p></o:p>
ActiveCell.FormulaR1C1 = "DATE 2"<o:p></o:p>
Columns("J:J").Select<o:p></o:p>
Selection.NumberFormat = "mmm/yy"<o:p></o:p>
Range("I1").Select<o:p></o:p>
ActiveCell.FormulaR1C1 = "VALUE 2"<o:p></o:p>
Range("I:I").Select<o:p></o:p>
With Selection<o:p></o:p>
Selection.NumberFormat = "General"<o:p></o:p>
.Value = .Value<o:p></o:p>
End With<o:p></o:p>
Rows("2:13").Select<o:p></o:p>
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove<o:p></o:p>
Range("J2").Select<o:p></o:p>
ActiveCell.FormulaR1C1 = "May-2010"<o:p></o:p>
Range("J3").Select<o:p></o:p>
ActiveCell.FormulaR1C1 = "Jun-2010"<o:p></o:p>
Range("J4").Select<o:p></o:p>
ActiveCell.FormulaR1C1 = "Jul-2010"<o:p></o:p>
Range("J5").Select<o:p></o:p>
ActiveCell.FormulaR1C1 = "Aug-2010"<o:p></o:p>
Range("J6").Select<o:p></o:p>
ActiveCell.FormulaR1C1 = "Sep-2010"<o:p></o:p>
Range("J7").Select<o:p></o:p>
ActiveCell.FormulaR1C1 = "Oct-2010"<o:p></o:p>
Range("J8").Select<o:p></o:p>
ActiveCell.FormulaR1C1 = "Nov-2010"<o:p></o:p>
Range("J9").Select<o:p></o:p>
ActiveCell.FormulaR1C1 = "Dec-2010"<o:p></o:p>
Range("J10").Select<o:p></o:p>
ActiveCell.FormulaR1C1 = "Jan-2011"<o:p></o:p>
Range("J11").Select<o:p></o:p>
ActiveCell.FormulaR1C1 = "Feb-2011"<o:p></o:p>
Range("J12").Select<o:p></o:p>
ActiveCell.FormulaR1C1 = "Mar-2011"<o:p></o:p>
Range("J13").Select<o:p></o:p>
ActiveCell.FormulaR1C1 = "Apr-2011"<o:p></o:p>
Range("J14").Select<o:p></o:p>
Range("F2").Select<o:p></o:p>
ActiveCell.FormulaR1C1 = "KFC"<o:p></o:p>
Range("F2").Select<o:p></o:p>
Selection.AutoFill Destination:=Range("F2:F13"), Type:=xlFillDefault<o:p></o:p>
Range("F2:F13").Select<o:p></o:p>
Range("F12").Select<o:p></o:p>
Range("A1").Select<o:p></o:p>
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _<o:p></o:p>
"Data!R1C1:R1048576C18", Version:=xlPivotTableVersion12).CreatePivotTable _<o:p></o:p>
TableDestination:="Pipeline!R1C1", TableName:="PivotTable2", _<o:p></o:p>
DefaultVersion:=xlPivotTableVersion12<o:p></o:p>
Sheets("Pipeline").Select<o:p></o:p>
Cells(1, 1).Select<o:p></o:p>
With ActiveSheet.PivotTables("PivotTable2").PivotFields("STATUS")<o:p></o:p>
.Orientation = xlRowField<o:p></o:p>
.Position = 1<o:p></o:p>
End With<o:p></o:p>
ActiveSheet.PivotTables("PivotTable2").AddDataField ActiveSheet.PivotTables( _<o:p></o:p>
"PivotTable2").PivotFields("DATE"), "Count of DATE", xlCount<o:p></o:p>
Sheets("Data").Select<o:p></o:p>
ActiveWorkbook.Worksheets("Pipeline").PivotTables("PivotTable2").PivotCache. _<o:p></o:p>
CreatePivotTable TableDestination:="Rejects!R1C1", TableName:="PivotTable3" _<o:p></o:p>
, DefaultVersion:=xlPivotTableVersion12<o:p></o:p>
Sheets("Rejects").Select<o:p></o:p>
Cells(1, 1).Select<o:p></o:p>
With ActiveSheet.PivotTables("PivotTable3").PivotFields("SUB STATUS")<o:p></o:p>
.Orientation = xlRowField<o:p></o:p>
.Position = 1<o:p></o:p>
End With<o:p></o:p>
ActiveSheet.PivotTables("PivotTable3").AddDataField ActiveSheet.PivotTables( _<o:p></o:p>
"PivotTable3").PivotFields("DATE"), "Count of DATE", xlCount<o:p></o:p>
Sheets("Data").Select<o:p></o:p>
ActiveWorkbook.Worksheets("Pipeline").PivotTables("PivotTable2").PivotCache. _<o:p></o:p>
CreatePivotTable TableDestination:="COMs!R1C1", TableName:="PivotTable4", _<o:p></o:p>
DefaultVersion:=xlPivotTableVersion12<o:p></o:p>
Sheets("COMs").Select<o:p></o:p>
Cells(1, 1).Select<o:p></o:p>
With ActiveSheet.PivotTables("PivotTable4").PivotFields("STATUS")<o:p></o:p>
.Orientation = xlRowField<o:p></o:p>
.Position = 1<o:p></o:p>
End With<o:p></o:p>
Columns("A:A").Select<o:p></o:p>
Selection.Delete Shift:=xlToLeft<o:p></o:p>
Range("A1").Select<o:p></o:p>
Sheets("Data").Select<o:p></o:p>
ActiveWorkbook.Worksheets("Pipeline").PivotTables("PivotTable2").PivotCache. _<o:p></o:p>
CreatePivotTable TableDestination:="COMs!R1C1", TableName:="PivotTable6", _<o:p></o:p>
DefaultVersion:=xlPivotTableVersion12<o:p></o:p>
Sheets("COMs").Select<o:p></o:p>
Cells(1, 1).Select<o:p></o:p>
With ActiveSheet.PivotTables("PivotTable6").PivotFields("DATE 2")<o:p></o:p>
.Orientation = xlColumnField<o:p></o:p>
.Position = 1<o:p></o:p>
End With<o:p></o:p>
With ActiveSheet.PivotTables("PivotTable6").PivotFields("STATUS")<o:p></o:p>
.Orientation = xlRowField<o:p></o:p>
.Position = 1<o:p></o:p>
End With<o:p></o:p>
ActiveSheet.PivotTables("PivotTable6").AddDataField ActiveSheet.PivotTables( _<o:p></o:p>
"PivotTable6").PivotFields("STATUS DATE"), "Count of STATUS DATE", xlCount<o:p></o:p>
Sheets(Array("Date Table", "Pipeline", "Rejects", "COMs", "Data")). _<o:p></o:p>
Select<o:p></o:p>
Sheets("Date Table").Activate<o:p></o:p>
ActiveWindow.SelectedSheets.Visible = False<o:p></o:p>
Sheets("Cover").Select<o:p></o:p>
<o:p> </o:p>
End Sub<o:p></o:p>

I Know its long winded but any help or ideas would be appreciated!!
 

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)
Sort by date Sort by votes
Eliminate all the .Select and subsequent Selection through out your code
This is poor usage of text

For example use:

Columns("B:C").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

versus

Columns("B:C").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
 
Upvote 0
this is a bit faster
Code: 
Sub Intorducer()
'
' Intorducer Macro
'
    Application.ScreenUpdating = False
    Columns("B:C").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("B1").Select
    Range("B1", Range("A65536").End(xlUp).Offset(, 1)).Formula = "=Left(A1,5)"
    Range("C2").Select
    Range("C2", Range("B65536").End(xlUp).Offset(, 1)).Formula = "=If(B2>0,vlookup(B2,'Date Table'!A:B,2,))"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "DATE"
    Columns("C:C").Select
    Selection.NumberFormat = "mmm/yy"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "VALUE"
    Range("B:B").Select
    With Selection
        Selection.NumberFormat = "General"
        .Value = .Value
    End With
    Columns("I:J").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("I1").Select
    Range("I1", Range("H65536").End(xlUp).Offset(, 1)).Formula = "=Left(H1,5)"
    Range("J2").Select
    Range("J2", Range("I65536").End(xlUp).Offset(, 1)).Formula = "=If(I2>0,vlookup(I2,'Date Table'!A:B,2,))"
    Range("J1").Select
    ActiveCell.FormulaR1C1 = "DATE 2"
    Columns("J:J").Select
    Selection.NumberFormat = "mmm/yy"
    Range("I1").Select
    ActiveCell.FormulaR1C1 = "VALUE 2"
    Range("I:I").Select
    With Selection
    Selection.NumberFormat = "General"
    .Value = .Value
    End With
    Rows("2:13").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("J2") = "May-2010"
    Range("J3") = "Jun-2010"
    Range("J4") = "Jul-2010"
    Range("J5") = "Aug-2010"
    Range("J6") = "Sep-2010"
    Range("J7") = "Oct-2010"
    Range("J8") = "Nov-2010"
    Range("J9") = "Dec-2010"
    Range("J10") = "Jan-2011"
    Range("J11") = "Feb-2011"
    Range("J12") = "Mar-2011"
    Range("J13") = "Apr-2011"
    Range("F2") = "KFC"
    Range("F2").Select
    Selection.AutoFill Destination:=Range("F2:F13"), Type:=xlFillDefault
    Range("A1").Select
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Data!R1C1:R1048576C18", Version:=xlPivotTableVersion12).CreatePivotTable _
        TableDestination:="Pipeline!R1C1", TableName:="PivotTable2", _
        DefaultVersion:=xlPivotTableVersion12
    Sheets("Pipeline").Select
    Cells(1, 1).Select
    With ActiveSheet.PivotTables("PivotTable2").PivotFields("STATUS")
        .Orientation = xlRowField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable2").AddDataField ActiveSheet.PivotTables( _
        "PivotTable2").PivotFields("DATE"), "Count of DATE", xlCount
    Sheets("Data").Select
    ActiveWorkbook.Worksheets("Pipeline").PivotTables("PivotTable2").PivotCache. _
        CreatePivotTable TableDestination:="Rejects!R1C1", TableName:="PivotTable3" _
        , DefaultVersion:=xlPivotTableVersion12
    Sheets("Rejects").Select
    Cells(1, 1).Select
    With ActiveSheet.PivotTables("PivotTable3").PivotFields("SUB STATUS")
        .Orientation = xlRowField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable3").AddDataField ActiveSheet.PivotTables( _
    "PivotTable3").PivotFields("DATE"), "Count of DATE", xlCount
    Sheets("Data").Select
    ActiveWorkbook.Worksheets("Pipeline").PivotTables("PivotTable2").PivotCache. _
    CreatePivotTable TableDestination:="COMs!R1C1", TableName:="PivotTable4", _
    DefaultVersion:=xlPivotTableVersion12
    Sheets("COMs").Select
    Cells(1, 1).Select
    With ActiveSheet.PivotTables("PivotTable4").PivotFields("STATUS")
        .Orientation = xlRowField
        .Position = 1
    End With
    Columns("A:A").Delete Shift:=xlToLeft
    Sheets("Data").Select
    ActiveWorkbook.Worksheets("Pipeline").PivotTables("PivotTable2").PivotCache. _
    CreatePivotTable TableDestination:="COMs!R1C1", TableName:="PivotTable6", _
    DefaultVersion:=xlPivotTableVersion12
    Sheets("COMs").Select
    Cells(1, 1).Select
    With ActiveSheet.PivotTables("PivotTable6").PivotFields("DATE 2")
        .Orientation = xlColumnField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable6").PivotFields("STATUS")
        .Orientation = xlRowField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable6").AddDataField ActiveSheet.PivotTables( _
    "PivotTable6").PivotFields("STATUS DATE"), "Count of STATUS DATE", xlCount
    Sheets(Array("Date Table", "Pipeline", "Rejects", "COMs", "Data")). _
    Select
    Sheets("Date Table").Activate
    ActiveWindow.SelectedSheets.Visible = False
    Sheets("Cover").Select
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Thank you for your replies i shall try them. Also, i have a few pivot tables in the macro and they all update quickly except for one which takes a few minutes to do as it looks up the information. Is there any reason for this? When i recorded the macro it took some time but it stalls at this point everytime i run it?

Thank you in advance.
 
Upvote 0
You may also want to after Application.Screenupdating = False, enter Application.Calculation = xlCalculationManual

then near the end

Application.Calculation = xlCalculationAutomatic
Application.Screenupdating = True
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question Question
Macro for
Replies
2
Views
120
Sanderb
S
S
  • Solved
Having trouble with pivot table macro
2
Replies
12
Views
321
RoryA
RoryA
D
  • Question Question
VBA Coding for adding Pivot Table with changing data table
Replies
6
Views
245
darmst24
D
J
  • Solved
VBA/Macro: Adding Pivot table with connection string
Replies
1
Views
252
Jette3173
J
C
  • Solved
VBA Add Pivot Table Sheet Name
Replies
1
Views
191
Anthony47
A

Forum statistics

Threads
1,224,600
Messages
6,179,836
Members
452,947
Latest member
Gerry_F

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top