VBA Macro never finishes

A

andres_fredo

New Member
Joined
Nov 12, 2014
Messages
24
Hi all,

I finished a macro which works by pulling 2 different data bases, working with some array formulas and creating some pivot tables. When using 2 relatively small data bases the macro takes around a minute to run and then it finishes with the expected values.

However when using large data bases the macro starts running but never finishes. I checked manually on the editor and went step by step, so I pressed F8 in the <acronym title="vBulletin" style="border-width: 0px 0px 1px; border-bottom-style: dotted; border-bottom-color: rgb(0, 0, 0); cursor: help;">VB</acronym> to see each command individually however when doing that there´s no hiccup and the macro finishes perfectly.

Do you know what might be happening?

Below is the full macro I have been using:

Sub Macro1_v10test()
Click to expand...
Application.ScreenUpdating = False


Application.Calculation = xlCalculationManual


'Variables
Dim wbCurrent, wbPrevious As Workbook
Dim sPath As String


'Open Current Report
Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False
sPath = Application.GetOpenFilename(Title:="Please select the Current Resource Trend Report.")
Set wbCurrent = Workbooks.Open(sPath)




'Open Previous Report
sPath = Application.GetOpenFilename(Title:="Please select the Previous Resource Trend Report.")
Set wbPrevious = Workbooks.Open(sPath)


'Copy over data from Current Report to first portion
wbCurrent.Activate
wbCurrent.Sheets("Raw Data").Activate
ActiveWorkbook.Sheets("Raw Data").Range("A1:V1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
ThisWorkbook.Sheets("Resource Trend-Current Version").Activate
Range("A1:V1").Select
Selection.PasteSpecial Paste:=xlPasteValues


'Copy over data from Current Report to second portion
wbCurrent.Activate
wbCurrent.Sheets("Raw Data").Activate
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Columns("C:C").Select
Selection.Delete Shift:=xlToLeft
Columns("C:C").Select
Selection.Delete Shift:=xlToLeft
Columns("C:C").Select
Selection.Delete Shift:=xlToLeft
Columns("C:C").Select
Selection.Delete Shift:=xlToLeft




ActiveWorkbook.Sheets("Raw Data").Range("A1:Q1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy


ThisWorkbook.Sheets("Resource Trend Current Month").Activate
Range("A1:Q1").Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False




Range("R1").Select
ActiveCell.FormulaR1C1 = "Version"
Range("R2").Select




Dim lf As Long
lf = Cells(Rows.Count, "D").End(xlUp).Row
Range("R2:R" & lf).Formula = "Current"






'Copy over data from Previous Report to first portion
wbPrevious.Activate
wbPrevious.Sheets("Raw Data").Activate
ActiveWorkbook.Sheets("Raw Data").Range("A1:V1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
ThisWorkbook.Sheets("Resource Trend-Previous Version").Activate
Range("A1:V1").Select
Selection.PasteSpecial Paste:=xlPasteValues




'Copy over data from Previous Report to second portion
wbPrevious.Activate
wbPrevious.Sheets("Raw Data").Activate


Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Columns("C:C").Select
Selection.Delete Shift:=xlToLeft
Columns("C:C").Select
Selection.Delete Shift:=xlToLeft
Columns("C:C").Select
Selection.Delete Shift:=xlToLeft
Columns("C:C").Select
Selection.Delete Shift:=xlToLeft


ActiveWorkbook.Sheets("Raw Data").Activate
Range("A1:Q1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy




ThisWorkbook.Sheets("Resource Trend Previous Month").Activate
Range("A1:Q1").Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False


Range("R1").Select
ActiveCell.FormulaR1C1 = "Version"
Range("R2").Select




Dim lg As Long
lg = Cells(Rows.Count, "D").End(xlUp).Row
Range("R2:R" & lg).Formula = "Previous"




Range("A2").Select
ThisWorkbook.Sheets("Resource Trend Previous Month").Activate
Range("A2:R2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy


Sheets("Resource Trend Current Month").Activate
Range("A1").Select
Selection.End(xlDown).Select
Selection.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False


Range("S1").Select
ActiveCell.FormulaR1C1 = "Delta"
Range("S2").Select


Dim lt As Long, R1C1formula As String
lt = Cells(Rows.Count, "E").End(xlUp).Row
Range("S2").Formula = "=IF($R2=""Current"",IF($U2=1,SUMIFS($K:$K,$F:$F,$F2,$J:$J,$J2,$M:$M,$M2,$R:$R,""Current"")-SUMIFS($K:$K,$F:$F,$F2,$J:$J,$J2,$M:$M,$M2,$R:$R,""Previous""),0),IF($R2=""Previous"",IF(ISNUMBER(MATCH(""Current"",IF($F:$F=$F2,IF($J:$J=$J2,IF($M:$M=$M2,$R:$R))),0)),0,-K2),""""))"
R1C1formula = Range("S2").FormulaR1C1
Range("S2").FormulaArray = R1C1formula
Range("S2:S" & lt).FillDown


Cells.Select
Calculate




Range("T2").Select




Dim la As Long
la = Cells(Rows.Count, "E").End(xlUp).Row
Range("T2:T" & la).Formula = "=CONCATENATE(F2,J2,M2,R2)"




Range("U2").Select

Dim lw As Long
lw = Cells(Rows.Count, "E").End(xlUp).Row
Range("U2:U" & lw).Formula = "=COUNTIF($T$2:T2,T2)"


Cells.Select
Calculate

Range("A1").Select


Range("S2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy




Range("K1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False


Range("A2").Select
ThisWorkbook.Sheets("Resource Trend Current Month").Activate
Range("A2:J2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.End(xlDown).Select
Selection.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False


Range("L2").Select
ThisWorkbook.Sheets("Resource Trend Current Month").Range("L2:Q2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.End(xlDown).Select
Selection.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False




Range("R2").Select


Range("R2:R" & Range("D" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeBlanks) = "Delta"


Sheet3.Activate
Range("A1").Select



ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"Resource Trend Current Month!R1C1:R1048576C18", Version:= _
xlPivotTableVersion15).CreatePivotTable TableDestination:="Sheet3!R1C1", _
TableName:="PivotTable1", DefaultVersion:=xlPivotTableVersion15
Sheets("Sheet3").Select
Cells(1, 1).Select



With ActiveSheet.PivotTables("PivotTable1").PivotFields("Name")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Category")
.Orientation = xlRowField
.Position = 2
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Date")
.Orientation = xlColumnField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Version")
.Orientation = xlColumnField
.Position = 2
End With
ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
"PivotTable1").PivotFields("Quantity"), "Count of Quantity", xlCount
With ActiveSheet.PivotTables("PivotTable1")
.InGridDropZones = True
.RowAxisLayout xlTabularRow
End With
ActiveSheet.PivotTables("PivotTable1").PivotFields("Type / Career Track"). _
Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields("Level").Subtotals = Array( _
False, False, False, False, False, False, False, False, False, False, False, False)


ActiveSheet.PivotTables("PivotTable1").PivotFields("Cost Collector").Subtotals _
= Array(False, False, False, False, False, False, False, False, False, False, _
False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields("Cost Collector Name"). _
Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields("Role Name").Subtotals = _
Array(False, False, False, False, False, False, False, False, False, False, False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields("Name").Subtotals = Array( _
False, False, False, False, False, False, False, False, False, False, False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields("Personnel Number"). _
Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields("Home Country").Subtotals = _
Array(False, False, False, False, False, False, False, False, False, False, False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields("Work Location").Subtotals _
= Array(False, False, False, False, False, False, False, False, False, False, False, False _
)
ActiveSheet.PivotTables("PivotTable1").PivotFields("Category").Subtotals = _
Array(False, False, False, False, False, False, False, False, False, False, False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields("Quantity").Subtotals = _
Array(False, False, False, False, False, False, False, False, False, False, False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields("A/F").Subtotals = Array( _
False, False, False, False, False, False, False, False, False, False, False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields("Date").Subtotals = Array( _
False, False, False, False, False, False, False, False, False, False, False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields("Order by").Subtotals = _
Array(False, False, False, False, False, False, False, False, False, False, False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields("BillRate Card Id"). _
Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields("Rate Name").Subtotals = _
Array(False, False, False, False, False, False, False, False, False, False, False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields("Bill Rate Card Name"). _
Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields("Version").Subtotals = Array _
(False, False, False, False, False, False, False, False, False, False, False, False)
ActiveSheet.PivotTables("PivotTable1").RowGrand = False
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Count of Quantity")
.Caption = "Sum of Quantity"
.Function = xlSum
End With
Range("E3").Select
ActiveSheet.PivotTables("PivotTable1").PivotFields("Version").PivotItems( _
"Delta").Position = 3
ActiveSheet.PivotTables("PivotTable1").TableStyle2 = "PivotStyleDark2"
ActiveSheet.PivotTables("PivotTable1").ShowTableStyleRowStripes = True
ActiveSheet.PivotTables("PivotTable1").PivotSelect "Delta", xlDataAndLabel, _
True
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent4
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With


Sheets("Resource Trend Current Month").Select
ActiveSheet.Visible = False
Sheets("Resource Trend Previous Month").Select
ActiveSheet.Visible = False
Sheets("Sheet3").Select
Sheets("Sheet3").Name = "Comparison"


ActiveWorkbook.SlicerCaches.Add2(ActiveSheet.PivotTables("PivotTable1"), _
"Category").Slicers.Add ActiveSheet, , "Category", "Category", 57, 334.5, 144, _
198.75
ActiveSheet.Shapes.Range(Array("Category")).Select
Range("A7").Select
ActiveWorkbook.SlicerCaches.Add2(ActiveSheet.PivotTables("PivotTable1"), _
"Level").Slicers.Add ActiveSheet, , "Level", "Level", 57, 334.5, 144, 198.75
ActiveSheet.Shapes.Range(Array("Level")).Select
Range("A8").Select
ActiveWorkbook.SlicerCaches.Add2(ActiveSheet.PivotTables("PivotTable1"), _
"Version").Slicers.Add ActiveSheet, , "Version", "Version", 57, 334.5, 144, _
198.75
ActiveSheet.Shapes.Range(Array("Version")).Select
Range("A7").Select
ActiveWorkbook.SlicerCaches.Add2(ActiveSheet.PivotTables("PivotTable1"), "Date" _
, , xlTimeline).Slicers.Add ActiveSheet, , "Date", "Date", 106.5, 275.25, 262.5 _
, 108
ActiveSheet.Shapes.Range(Array("Date")).Select
ActiveWindow.Zoom = 90
ActiveSheet.Shapes.Range(Array("Version")).Select
ActiveSheet.Shapes("Version").IncrementLeft -162.5
ActiveSheet.Shapes("Version").IncrementTop -57
ActiveSheet.Shapes("Version").ScaleWidth 1.0023039656, msoFalse, _
msoScaleFromTopLeft
ActiveSheet.Shapes("Version").ScaleHeight 0.4528301887, msoFalse, _
msoScaleFromTopLeft
ActiveSheet.Shapes.Range(Array("Level")).Select
ActiveSheet.Shapes("Level").IncrementLeft -312.6666929134
ActiveSheet.Shapes("Level").IncrementTop -56.6666929134
ActiveSheet.Shapes("Level").ScaleWidth 1.0668975288, msoFalse, _
msoScaleFromTopLeft
ActiveSheet.Shapes("Level").ScaleHeight 0.4679245283, msoFalse, _
msoScaleFromTopLeft
ActiveSheet.Shapes("Level").ScaleWidth 0.989189526, msoFalse, _
msoScaleFromTopLeft
ActiveSheet.Shapes("Level").ScaleHeight 1.2060926255, msoFalse, _
msoScaleFromTopLeft
ActiveSheet.Shapes("Level").ScaleHeight 1.0594356259, msoFalse, _
msoScaleFromTopLeft
ActiveSheet.Shapes.Range(Array("Version")).Select
ActiveSheet.Shapes("Version").IncrementLeft -16.6666141732
ActiveSheet.Shapes("Version").IncrementTop -0.00007874015748
ActiveSheet.Shapes("Version").IncrementLeft 246.6666929134
ActiveSheet.Shapes("Version").IncrementTop 13.3333858268
ActiveSheet.Shapes.Range(Array("Category")).Select
ActiveSheet.Shapes("Category").IncrementLeft -159.1666929134
ActiveSheet.Shapes("Category").IncrementTop -57
ActiveSheet.Shapes.Range(Array("Date")).Select
ActiveSheet.Shapes("Date").IncrementLeft 282.5
ActiveSheet.Shapes("Date").IncrementTop -104.1666141732
ActiveSheet.Shapes.Range(Array("Category")).Select
ActiveSheet.Shapes("Category").ScaleWidth 0.875432526, msoFalse, _
msoScaleFromTopLeft
ActiveSheet.Shapes("Category").ScaleHeight 0.5953877086, msoFalse, _
msoScaleFromTopLeft
ActiveSheet.Shapes.Range(Array("Version")).Select
ActiveSheet.Shapes("Version").IncrementLeft -122.5
ActiveSheet.Shapes("Version").IncrementTop -12.5
ActiveSheet.Shapes.Range(Array("Date")).Select
ActiveSheet.Shapes("Date").IncrementLeft -132.5
ActiveSheet.Shapes("Date").IncrementTop -2.3333858268
Rows("1:8").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ActiveSheet.Shapes.Range(Array("Level")).Select
ActiveSheet.Shapes("Level").IncrementTop -120.3333070866
ActiveSheet.Shapes.Range(Array("Category")).Select
ActiveSheet.Shapes("Category").IncrementTop -120
ActiveSheet.Shapes.Range(Array("Version")).Select
ActiveSheet.Shapes("Version").IncrementLeft 0.8333070866
ActiveSheet.Shapes("Version").IncrementTop -120.8333858268
ActiveSheet.Shapes.Range(Array("Date")).Select
ActiveSheet.Shapes("Date").IncrementLeft 1.6666929134
ActiveSheet.Shapes("Date").IncrementTop -120


ActiveWorkbook.SlicerCaches("Slicer_Level").ClearManualFilter






Range("A1").Select


'Create Headcount info
Sheets("Comparison").Select
Sheets("Resource Trend Current Month").Visible = True
Sheets.Add After:=ActiveSheet
Sheets("Sheet1").Select
Sheets("Sheet1").Move After:=Sheets(4)
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "Headcount"
Range("A7").Select
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"Resource Trend Current Month!R1C2:R1048576C18", Version:= _
xlPivotTableVersion15).CreatePivotTable TableDestination:="Headcount!R7C1", _
TableName:="PivotTable1", DefaultVersion:=xlPivotTableVersion15
Sheets("Headcount").Select
Cells(7, 1).Select
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Level")
.Orientation = xlRowField
.Position = 1
End With
ActiveWindow.SmallScroll Down:=-3
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Name")
.Orientation = xlRowField
.Position = 2
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Category")
.Orientation = xlRowField
.Position = 3
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Date")
.Orientation = xlColumnField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Version")
.Orientation = xlColumnField
.Position = 2
End With
ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
"PivotTable1").PivotFields("Quantity"), "Count of Quantity", xlCount
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Count of Quantity")
.Caption = "Sum of Quantity"
.Function = xlSum
End With
ActiveWorkbook.SlicerCaches.Add2(ActiveSheet.PivotTables("PivotTable1"), _
"Category").Slicers.Add ActiveSheet, , "Category 1", "Category", 60.75, 315.75 _
, 144, 198.75
ActiveWorkbook.SlicerCaches.Add2(ActiveSheet.PivotTables("PivotTable1"), _
"Version").Slicers.Add ActiveSheet, , "Version 1", "Version", 98.25, 353.25, _
144, 198.75
ActiveSheet.Shapes.Range(Array("Version 1")).Select
ActiveSheet.PivotTables("PivotTable1").PivotSelect "Name[All]", xlLabelOnly + _
xlFirstRow, True
ActiveSheet.PivotTables("PivotTable1").PivotFields("Level").Subtotals = Array( _
False, False, False, False, False, False, False, False, False, False, False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields("Cost Collector").Subtotals _
= Array(False, False, False, False, False, False, False, False, False, False, _
False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields("Cost Collector Name"). _
Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields("Role Name").Subtotals = _
Array(False, False, False, False, False, False, False, False, False, False, False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields("Name").Subtotals = Array( _
False, False, False, False, False, False, False, False, False, False, False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields("Personnel Number"). _
Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields("Home Country").Subtotals = _
Array(False, False, False, False, False, False, False, False, False, False, False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields("Work Location").Subtotals _
= Array(False, False, False, False, False, False, False, False, False, False, False, False _
)
ActiveSheet.PivotTables("PivotTable1").PivotFields("Category").Subtotals = _
Array(False, False, False, False, False, False, False, False, False, False, False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields("Quantity").Subtotals = _
Array(False, False, False, False, False, False, False, False, False, False, False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields("A/F").Subtotals = Array( _
False, False, False, False, False, False, False, False, False, False, False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields("Date").Subtotals = Array( _
False, False, False, False, False, False, False, False, False, False, False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields("Order by").Subtotals = _
Array(False, False, False, False, False, False, False, False, False, False, False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields("BillRate Card Id"). _
Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields("Rate Name").Subtotals = _
Array(False, False, False, False, False, False, False, False, False, False, False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields("Bill Rate Card Name"). _
Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields("Version").Subtotals = Array _
(False, False, False, False, False, False, False, False, False, False, False, False)
With ActiveSheet.PivotTables("PivotTable1")
.ColumnGrand = False
.RowGrand = False
End With
With ActiveSheet.PivotTables("PivotTable1")
.InGridDropZones = True
.RowAxisLayout xlTabularRow
End With
ActiveSheet.Shapes.Range(Array("Category 1")).Select
ActiveSheet.Shapes("Category 1").IncrementLeft -408.75
ActiveSheet.Shapes("Category 1").IncrementTop -60.75
ActiveSheet.Shapes("Category 1").ScaleWidth 0.984375, msoFalse, _
msoScaleFromTopLeft
ActiveSheet.Shapes("Category 1").ScaleHeight 0.4150943396, msoFalse, _
msoScaleFromTopLeft
ActiveSheet.Shapes.Range(Array("Version 1")).Select
ActiveSheet.Shapes("Version 1").IncrementLeft -301.5
ActiveSheet.Shapes("Version 1").IncrementTop -98.25
ActiveSheet.Shapes("Version 1").ScaleWidth 0.9166666667, msoFalse, _
msoScaleFromTopLeft
ActiveSheet.Shapes("Version 1").ScaleHeight 0.4150943396, msoFalse, _
msoScaleFromTopLeft
With ActiveWorkbook.SlicerCaches("Slicer_Category1")
.SlicerItems("Hours").Selected = True
.SlicerItems("Bill Rate").Selected = False
.SlicerItems("Billings").Selected = False
.SlicerItems("Cost Rate").Selected = False
.SlicerItems("Margin %").Selected = False
.SlicerItems("Non-Payroll Costs/Expenses").Selected = False
.SlicerItems("Payroll").Selected = False
.SlicerItems("(blank)").Selected = False
End With
With ActiveWorkbook.SlicerCaches("Slicer_Version1")
.SlicerItems("Current").Selected = True
.SlicerItems("Delta").Selected = False
.SlicerItems("Previous").Selected = False
.SlicerItems("(blank)").Selected = False
End With
With ActiveWorkbook.SlicerCaches("Slicer_Version1")
.SlicerItems("Current").Selected = True
.SlicerItems("Delta").Selected = True
.SlicerItems("Previous").Selected = False
.SlicerItems("(blank)").Selected = False
End With
With ActiveWorkbook.SlicerCaches("Slicer_Version1")
.SlicerItems("Current").Selected = True
.SlicerItems("Delta").Selected = False
.SlicerItems("Previous").Selected = False
.SlicerItems("(blank)").Selected = False
End With
With ActiveWorkbook.SlicerCaches("Slicer_Version1")
.SlicerItems("Current").Selected = True
.SlicerItems("Previous").Selected = True
.SlicerItems("Delta").Selected = False
.SlicerItems("(blank)").Selected = False
End With
ActiveWorkbook.SlicerCaches.Add2(ActiveSheet.PivotTables("PivotTable1"), "Date" _
, , xlTimeline).Slicers.Add ActiveSheet, , "Date 1", "Date", 129, 275.25, 262.5 _
, 108
ActiveSheet.Shapes.Range(Array("Date 1")).Select
ActiveSheet.Shapes("Date 1").IncrementLeft 293.25
ActiveSheet.Shapes("Date 1").IncrementTop -129
Columns("A:G").Select
Range("G1").Activate
Selection.EntireColumn.Hidden = True
Sheets("Resource Trend Current Month").Select
ActiveWindow.SelectedSheets.Visible = False
Sheets("Headcount").Select
Columns("A:H").Select
Range("H1").Activate
Selection.EntireColumn.Hidden = False

ActiveSheet.PivotTables("PivotTable1").PivotSelect "Level[All]", xlLabelOnly, _
True
Range("A10").Select
ActiveSheet.PivotTables("PivotTable1").PivotFields("Level").RepeatLabels = True


'Create CountIFs


Sheets.Add After:=ActiveSheet
Sheets("Sheet2").Select
Sheets("Sheet2").Name = "Pyramid structure"
Range("A10").Select




Range("A10").Select
ActiveCell.FormulaR1C1 = "Level"
Range("B10").Select
ActiveCell.FormulaR1C1 = "Current"
Range("C10").Select
ActiveCell.FormulaR1C1 = "Previous"
Range("A11").Select
ActiveCell.FormulaR1C1 = "13 - Associate"
Range("A12").Select
ActiveCell.FormulaR1C1 = "12 - Associate"
Range("A13").Select
ActiveCell.FormulaR1C1 = "11 - Analyst"
Range("A14").Select
ActiveCell.FormulaR1C1 = "10 - Analyst"
Range("A15").Select
ActiveCell.FormulaR1C1 = "9 - Consultant"
Range("A16").Select
ActiveCell.FormulaR1C1 = "8 - Consultant"
Range("A17").Select
ActiveCell.FormulaR1C1 = "7 - Manager"
Range("A18").Select
ActiveCell.FormulaR1C1 = "6 - Senior Manager"
Range("A19").Select
ActiveCell.FormulaR1C1 = "Accenture Leadership"
Range("H19").Select
Columns("A:A").EntireColumn.AutoFit




Range("B11").Select
ActiveCell.FormulaR1C1 = "=COUNTIFS(Headcount!C[-1],'Pyramid structure'!RC[-1],Headcount!C[2],"">0"")"
Range("C11").Select
ActiveCell.FormulaR1C1 = "=-COUNTIFS(Headcount!C[-2],'Pyramid structure'!RC[-2],Headcount!C[2],"">0"")"

Range("B11:C11").Select
Selection.AutoFill Destination:=Range("B11:C19"), Type:=xlFillDefault
Range("B11:C19").Select
Range("N1").Select
Cells.Select
Application.Calculation = xlAutomatic
Range("A1").Select








'Create Chart
Selection.NumberFormat = "0;0"
Selection.Copy
Range("C11:C19").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("A1").Select




ActiveSheet.Shapes.AddChart2(216, xlBarClustered).Select
ActiveChart.SetSourceData Source:=Range("A10:C19")
ActiveChart.ChartTitle.Select
ActiveChart.Axes(xlValue).MajorGridlines.Select
ActiveSheet.ChartObjects("chart 1").Activate
ActiveChart.ChartTitle.Select
ActiveChart.ChartTitle.Text = "Pyramid Structure"
Selection.Format.TextFrame2.TextRange.Characters.Text = "Pyramid Structure"
With Selection.Format.TextFrame2.TextRange.Characters(1, 17).ParagraphFormat
.TextDirection = msoTextDirectionLeftToRight
.Alignment = msoAlignCenter
End With
With Selection.Format.TextFrame2.TextRange.Characters(1, 17).Font
.BaselineOffset = 0
.Bold = msoFalse
.NameComplexScript = "+mn-cs"
.NameFarEast = "+mn-ea"
.Fill.Visible = msoTrue
.Fill.ForeColor.RGB = RGB(89, 89, 89)
.Fill.Transparency = 0
.Fill.Solid
.Size = 14
.Italic = msoFalse
.Kerning = 12
.Name = "+mn-lt"
.UnderlineStyle = msoNoUnderline
.Spacing = 0
.Strike = msoNoStrike
End With
ActiveChart.ChartArea.Select
ActiveChart.Axes(xlCategory).Select
ActiveChart.SetElement (msoElementLegendRight)
ActiveChart.Axes(xlCategory).Select
ActiveChart.Axes(xlCategory).Select
Selection.TickLabelPosition = xlLow
Range("S22").Select
ActiveSheet.ChartObjects("chart 1").Activate
ActiveSheet.Shapes("chart 1").IncrementLeft -3
ActiveSheet.Shapes("chart 1").IncrementTop -72
ActiveSheet.ChartObjects("chart 1").Activate
ActiveSheet.Shapes("chart 1").ScaleWidth 1.0833333333, msoFalse, _
msoScaleFromTopLeft
ActiveSheet.Shapes("chart 1").ScaleHeight 1.3107640712, msoFalse, _
msoScaleFromTopLeft
Application.CommandBars("Format Object").Visible = False
Range("U1").Select




ActiveSheet.ChartObjects("chart 1").Activate
ActiveSheet.ChartObjects("chart 1").Activate
ActiveChart.Axes(xlValue).Select
Selection.TickLabels.NumberFormat = _
"_(* #,##0_);_(* (#,##0);_(* ""-""??_);_(@_)"
Selection.TickLabels.NumberFormat = "0;0"
Range("U8").Select
Application.CommandBars("Format Object").Visible = False


'Final details




Sheets("Headcount").Select
ActiveSheet.Shapes.Range(Array("Date 1")).Select
Selection.Copy
Sheets("Pyramid structure").Select
Range("A1").Select
ActiveSheet.Paste

ActiveSheet.Shapes.Range(Array("Date 2")).Select
Sheets("Comparison").Select
Range("A1").Select
ActiveSheet.PivotTables("PivotTable1").PivotSelect "Delta", xlDataAndLabel, _
True
Selection.FormatConditions.AddColorScale ColorScaleType:=3
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
Selection.FormatConditions(1).ColorScaleCriteria(1).Type = _
xlConditionValueLowestValue
With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor
.Color = 7039480
.TintAndShade = 0
End With


Range("A1").Select


Sheets("Headcount").Select
ActiveWindow.SelectedSheets.Visible = False
Sheets("Comparison").Select
Range("A1").Select

Sheets("Resource Trend-Previous Version").Select
ActiveWindow.SelectedSheets.Visible = False
Sheets("Resource Trend-Current Version").Select
ActiveWindow.SelectedSheets.Visible = False
Sheets("Comparison").Select
Sheets("Comparison").Move Before:=Sheets(6)
Sheets("Variance").Select
Range("G3").Select
ActiveSheet.PivotTables("PivotTable4").PivotCache.Refresh
Range("B4").Select
ActiveSheet.PivotTables("PivotTable2").PivotCache.Refresh
Sheets("Summary").Select
Range("K14").Select
ActiveSheet.PivotTables("PivotTable4").PivotCache.Refresh
ActiveSheet.PivotTables("PivotTable3").PivotSelect "'Added Resources '[All]", _
xlLabelOnly, True
ActiveSheet.PivotTables("PivotTable3").PivotCache.Refresh
ActiveSheet.PivotTables("PivotTable5").PivotSelect _
"'Sum of Cost Rate Variance'", xlDataAndLabel, True
ActiveSheet.PivotTables("PivotTable5").PivotCache.Refresh
Range("A1").Select





'Close files
wbCurrent.Close (False)
wbPrevious.Close (False)




Application.Calculation = xlCalculationAutomatic


Application.ScreenUpdating = True


End Sub
Click to expand...


Thanks, Andy​



 

Excel Facts

Create a chart in one keystroke
Select the data and press Alt+F1 to insert a default chart. You can change the default chart to any chart type
Sort by date Sort by votes
You must log in or register to reply here.

Similar threads

C
  • Solved
VBA Add Pivot Table Sheet Name
Replies
1
Views
166
Anthony47
A
C
  • Question Question
Pivot Table VBA
Replies
0
Views
206
chaddres
C
Sean15
  • Question Question
Could you help improve recorded macro
2
Replies
13
Views
412
Sean15
Sean15
C
  • Solved
Pivot Table VBA
Replies
1
Views
358
Misca
M
J
  • Question Question
VBA removing heading in spreadsheet
Replies
3
Views
239
rlv01
R

Forum statistics

Threads
1,223,275
Messages
6,171,122
Members
452,381
Latest member
Nova88

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