Consulting

Results 1 to 2 of 2

Thread: Solved: Code Errors out on Pivot Tables

  1. #1
    VBAX Regular
    Joined
    May 2008
    Posts
    46
    Location

    Solved: Code Errors out on Pivot Tables

    I got such awesome help the last time I posted something that I'm going to try again.

    I have a query that I download the results every month and then run a macro on it. I do the macro so that it is the same everytime. What the macro does is sorts the data and then builds some pivot tables and performs some other things. It errors out on me because of some pivot table grouping that I have it do.

    I can't really describe what it does/doesn't do so I provided my code and a sample file. I did most of this macro by recording it and then modified it a little. I'm still a little new at editing VBA so it will probably be messy.

    Thanks to all that help. I hope that my sample file it sufficient.

    [vba]Sub Inventory_Sort()
    '
    ' Inventory_Sort Macro
    ' This sorts out a specific output from SAP to show our Cert Inventory in a Dynamic way.
    '
    ' Keyboard Shortcut: Ctrl+Shift+S
    '
    Application.ScreenUpdating = False



    Windows("Test Inventory.XLS").Activate
    Rows("1:4").Select
    Selection.Delete Shift:=xlUp
    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
    Selection.End(xlDown).Select
    Range("A2").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    ActiveWorkbook.Worksheets("Test Inventory").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Test Inventory").Sort.SortFields.Add Key:=Range( _
    "D"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
    With ActiveWorkbook.Worksheets("Test Inventory").Sort
    .SetRange Range("A:K")
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
    End With
    Range("A1").Select
    Cells.Find(What:="sold", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
    :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
    False, SearchFormat:=False).Activate
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.ClearContents
    Selection.End(xlUp).Select
    Selection.End(xlUp).Select

    Dim Counter, KillOn
    KillOn = False
    Counter = 2
    Do While (Counter <= 500000) And (KillOn = False)
    Range("C" & Counter).Select
    If IsEmpty(ActiveCell) Then
    KillOn = True

    Else: Counter = Counter + 1
    End If
    Loop
    Counter = Counter - 1


    'Insert Column to Find Days to Expiration
    Columns("D").Select
    Range("D1").Activate
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "Days to Expiration"
    Range("D").Select
    Selection.NumberFormat = "0"
    With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlBottom
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
    End With




    Range("d2").Select
    ActiveCell.FormulaR1C1 = "=RC[+1]-today()"
    Range("D2" & Counter).Select
    Selection.FillDown
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Columns("D").EntireColumn.AutoFit
    Columns("E:E").EntireColumn.AutoFit


    'Insert Column to Find a Description of what type of cert
    Columns("D").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "Material Description"
    Range("D2").Select
    ActiveCell.FormulaR1C1 = _
    "=VLOOKUP(RC3,'[Inventory Sort Macro.xlsm]Sheet1'!R3C1:R28C2,2,0)"
    Range("D2" & Counter).Select
    Selection.FillDown
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Columns("D").EntireColumn.AutoFit


    'Insert Column to Find Market
    Columns("L:L").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("L1").Select
    ActiveCell.FormulaR1C1 = "Market"
    Range("L2").Select
    ActiveCell.FormulaR1C1 = _
    "=VLOOKUP(RC11,'[Inventory Sort Macro.xlsm]Sheet1'!R31C1:R41493C3,3,FALSE)"
    Range("L2:L" & Counter).Select
    Selection.FillDown
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Columns("L:L").EntireColumn.AutoFit

    'Insert Column with number of certs to calculate dollar value
    Range("N1").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "Number of Certs"
    Range("N2").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("N2:N" & Counter).Select
    Selection.FillDown

    'Insert column to Group number of days to expiration

    Columns("F:F").Select
    Selection.Insert Shift:=xlToRight
    Range("F1").Select
    ActiveCell.FormulaR1C1 = "Day Grouping"
    Range("F2").Select
    ActiveCell.FormulaR1C1 = _
    "=IF(RC[-1]<-180,""-000000180+"",IF(AND(RC[-1]>=-180,RC[-1]<-150),""-00000180 to -151"",IF(AND(RC[-1]>=-150,RC[-1]<-120),""-0000150 to -121"",IF(AND(RC[-1]>=-120,RC[-1]<-90),""-0000120 to -91"",IF(AND(RC[-1]>=-90,RC[-1]<-60),""-000090 to -61"",IF(AND(RC[-1]>=-60,RC[-1]<-30),""-000060 to -31"",IF(AND(RC[-1]>=-30,RC[-1]<0),""-00030 to 0"",IF(AND(RC[-1]>=0,RC[-1]<16),""001 to 15"",IF(AND(RC[-1]>=16,RC[-1]<31),""016 to 30"",IF(AND(RC[-1]>=31,RC[-1]<46),""031 to 45"",IF(AND(RC[-1]>=46,RC[-1]<61),""046 to 60"",IF(AND(RC[-1]>=61,RC[-1]<76),""061 to 75"",IF(AND(RC[-1]>=76,RC[-1]<91),""076 to 90"",IF(AND(RC[-1]>=91,RC[-1]<106),""091 to 105"",IF(AND(RC[-1]>=106,RC[-1]<121),""106 to 120"",IF(AND(RC[-1]>=121,RC[-1]<136),""121 to 135"",IF(AND(RC[-1]>=136,RC[-1]<151),""136 to 150"",IF(AND(RC[-1]>=151,RC[-1]<166),""151 to 165"",IF(AND(RC[-1]>=166,RC[-1]<181),""165 to 180"",IF(AND(RC[-1]>=181,RC[-1]<196),""181 to 195""," & _
    "IF(AND(RC[-1]>=196,RC[-1]<211),""196 to 210"",IF(AND(RC[-1]>=211,RC[-1]<226),""211 to 225"",IF(AND(RC[-1]>=226,RC[-1]<241),""226 to 240"",IF(AND(RC[-1]>=241,RC[-1]<266),""241 to 265"",IF(AND(RC[-1]>=266,RC[-1]<281),""266 to 280"",IF(AND(RC[-1]>=281,RC[-1]<296),""281 to 295"",IF(AND(RC[-1]>=296,RC[-1]<311),""296 to 310"",IF(AND(RC[-1]>=311,RC[-1]<326),""311 to 325"",IF(AND(RC[-1]>=326,RC[-1]<341),""326 to 340"",IF(AND(RC[-1]>=341,RC[-1]<356),""341 to 355"",""355+""))))))))))))))))))))))))))))))"



    Range("F2:F" & Counter).Select
    Selection.FillDown
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Columns("F:F").EntireColumn.AutoFit

    'Create Pivot Table

    Range("A1:O" & Counter).Select
    Sheets.Add



    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
    "Test Inventory!R1C1:R1048576C15", Version:=xlPivotTableVersion12). _
    CreatePivotTable TableDestination:="Sheet1!R3C1", TableName:="CertInventory" _
    , DefaultVersion:=xlPivotTableVersion12
    Sheets("Sheet1").Select
    Sheets("Sheet1").Name = "Inventory Pivot Table"


    Sheets("Inventory Pivot Table").Select
    Cells(3, 1).Select
    ActiveWorkbook.ShowPivotTableFieldList = True
    With ActiveSheet.PivotTables("CertInventory").PivotFields("Material Description")
    .Orientation = xlRowField
    .Position = 1
    End With
    With ActiveSheet.PivotTables("CertInventory").PivotFields("Market")
    .Orientation = xlRowField
    .Position = 2
    End With
    With ActiveSheet.PivotTables("CertInventory").PivotFields("Day Grouping")
    .Orientation = xlColumnField
    .Position = 1
    End With
    ActiveSheet.PivotTables("CertInventory").AddDataField ActiveSheet.PivotTables( _
    "CertInventory").PivotFields("Material"), "Sum of Material", xlSum
    With ActiveSheet.PivotTables("CertInventory").PivotFields("Sum of Material")
    .Caption = "Count of Material"
    .Function = xlCount

    End With


    With ActiveSheet.PivotTables("CertInventory").PivotFields( _
    "Material Description")
    '.PivotItems("#N/A").Visible = False
    .PivotItems("(blank)").Visible = False
    End With
    With ActiveSheet.PivotTables("CertInventory").PivotFields("Market")
    .PivotItems("#N/A").Visible = False
    .PivotItems("(blank)").Visible = False
    End With
    With ActiveSheet.PivotTables("CertInventory").PivotFields("Day Grouping")
    .PivotItems("(blank)").Visible = False
    End With
    Range("B6").Select
    ActiveWindow.FreezePanes = True

    ActiveSheet.PivotTables("CertInventory").TableStyle2 = "PivotStyleDark23"
    ActiveWorkbook.ShowPivotTableFieldList = False
    Range("B3").Select
    ActiveSheet.PivotTables("CertInventory").CompactLayoutColumnHeader = _
    "Days to Expiration"
    Range("B4").Select
    Columns("B:B").EntireColumn.AutoFit


    'Add another sheet to run a forecast on


    Range("A1").Select
    ActiveSheet.PivotTables("CertInventory").MergeLabels = True
    Range("B5").Select
    ActiveSheet.PivotTables("CertInventory").DataPivotField.PivotItems( _
    "Count of Material").Caption = "# of Certs"
    Range("C5").Select

    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets("Sheet2").Select
    Sheets("Sheet2").Name = "Inventory Forecast Control"

    Range("A3").Select
    ActiveCell.FormulaR1C1 = "='Inventory Pivot Table'!RC"
    Range("A3").Select
    Selection.AutoFill Destination:=Range("A3:A2000"), Type:=xlFillDefault
    Range("A3:A2000").Select

    Range("A3").Select
    Selection.AutoFill Destination:=Range("A3:B3"), Type:=xlFillDefault

    Range("A4").Select
    Selection.AutoFill Destination:=Range("A4:AA4"), Type:=xlFillDefault
    Range("A4:AA4").Select
    ActiveWindow.SmallScroll ToRight:=2
    Selection.AutoFill Destination:=Range("A4:AC4"), Type:=xlFillDefault
    Range("A4:AC4").Select

    Selection.AutoFill Destination:=Range("A4:AN4"), Type:=xlFillDefault
    Range("A4:AN4").Select

    Columns("A:A").EntireColumn.AutoFit
    Columns("B:AN").Select
    Columns("B:AN").EntireColumn.AutoFit
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Close Rate"
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "Show Rate"
    Range("F1").Select
    ActiveCell.FormulaR1C1 = "Upsell %"
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "Upsell $"



    Range("B5").Select
    ActiveCell.FormulaR1C1 = _
    "=IF(R1C3="""",'Inventory Pivot Table'!RC,IF('Inventory Forecast Control'!R1C5="""",'Inventory Pivot Table'!RC*'Inventory Forecast Control'!R1C3,IF('Inventory Forecast Control'!R1C7="""",'Inventory Pivot Table'!RC*'Inventory Forecast Control'!R1C3*'Inventory Forecast Control'!R1C5,IF('Inventory Forecast Control'!R1C9="""",'Inventory Pivot Table'!RC*'Inventory Forecast Control'!R1C3*'Inventory Forecast Control'!R1C5*'Inventory Forecast Control'!R1C7,TEXT('Inventory Pivot Table'!RC*'Inventory Forecast Control'!R1C3*'Inventory Forecast Control'!R1C5*'Inventory Forecast Control'!R1C7*'Inventory Forecast Control'!R1C9,""$ #,###.00"")))))"
    Range("B6").Select


    Range("B5").Select
    Selection.AutoFill Destination:=Range("B5:AN5"), Type:=xlFillDefault
    Range("B5:AN5").Select


    Selection.AutoFill Destination:=Range("B5:AN2000"), Type:=xlFillDefault
    Range("B5:AN2000").Select

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .ColorIndex = xlAutomatic
    .TintAndShade = 0
    .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .ColorIndex = xlAutomatic
    .TintAndShade = 0
    .Weight = xlMedium
    End With
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

    Columns("A:A").Select
    Selection.Font.Bold = True
    Rows("1:4").Select
    Selection.Font.Bold = True

    Range("C1").Select
    Selection.Style = "Percent"
    With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = -0.149998474074526
    .PatternTintAndShade = 0
    End With
    Range("E1").Select
    Selection.Style = "Percent"
    With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = -0.149998474074526
    .PatternTintAndShade = 0
    End With
    Range("G1").Select
    Selection.Style = "Percent"
    With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = -0.149998474074526
    .PatternTintAndShade = 0
    End With
    Range("I1").Select
    Selection.Style = "Currency"
    With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = -0.149998474074526
    .PatternTintAndShade = 0
    End With
    Cells.Select
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
    Formula1:="=0"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriori ty
    With Selection.FormatConditions(1).Font
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Range("A1").Select

    Sheets("Inventory Pivot Table").Select
    ActiveSheet.PivotTables("CertInventory").PivotSelect "", xlDataAndLabel, True
    Selection.Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    Range("A3").Select
    ActiveSheet.Paste
    Sheets("Sheet3").Select
    Sheets("Sheet3").Name = "Dialed In Inventory"
    Application.CutCopyMode = False
    ActiveWorkbook.ShowPivotTableFieldList = True

    ActiveSheet.PivotTables("PivotTable5").Name = "PivotTable1"

    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Market")
    .Orientation = xlPageField
    .Position = 1
    End With



    ActiveWorkbook.ShowPivotTableFieldList = False
    ' ActiveSheet.PivotTables("PivotTable1").PivotSelect _
    "'-00000180 to -151':'-00030 to 0'", xlDataAndLabel, True
    ' Selection.Group
    ' ActiveSheet.PivotTables("PivotTable1").PivotSelect _
    "'-00000180 to -151':'-00030 to 0'", xlDataAndLabel, True
    Range("B4:E4").Select
    ' ActiveSheet.PivotTables("PivotTable1").PivotFields("Day Grouping2").PivotItems( _
    "Group1").Caption = "Expired Certs up to 180 Days old"
    Range("B4").Select
    ' ActiveSheet.PivotTables("PivotTable1").PivotFields("Day Grouping2").PivotItems( _
    "Expired Certs up to 180 Days old").ShowDetail = False
    ' ActiveSheet.PivotTables("PivotTable1").PivotSelect _
    "'Day Grouping2'['001 to 15':'076 to 90']", xlDataAndLabel, True
    ' Selection.Group
    Range("C4:H4").Select
    ' ActiveSheet.PivotTables("PivotTable1").PivotFields("Day Grouping2").PivotItems( _
    "Group2").Caption = "Expiring in 3 Months"
    Range("C4").Select
    ' ActiveSheet.PivotTables("PivotTable1").PivotFields("Day Grouping2").PivotItems( _
    "Expiring in 3 Months").ShowDetail = False
    ' ActiveSheet.PivotTables("PivotTable1").PivotSelect _
    "'Day Grouping2'['091 to 105':'165 to 180']", xlDataAndLabel, True
    ' Selection.Group
    ' ActiveSheet.PivotTables("PivotTable1").PivotFields("Day Grouping2").PivotItems( _
    "Group3").Caption = "Expiring 3 to 6 months"
    Range("D4").Select
    ' ActiveSheet.PivotTables("PivotTable1").PivotFields("Day Grouping2").PivotItems( _
    "Expiring 3 to 6 months").ShowDetail = False
    ' ActiveSheet.PivotTables("PivotTable1").PivotSelect _
    "'Day Grouping2'['181 to 195':'241 to 265']", xlDataAndLabel, True
    ' Selection.Group
    ' ActiveSheet.PivotTables("PivotTable1").PivotFields("Day Grouping2").PivotItems( _
    "Group4").Caption = "Expiring 6 to 9 months"
    Range("E4").Select
    ' ActiveSheet.PivotTables("PivotTable1").PivotFields("Day Grouping2").PivotItems( _
    "Expiring 6 to 9 months").ShowDetail = False
    ' ActiveSheet.PivotTables("PivotTable1").PivotSelect _
    "'Day Grouping2'['266 to 280':'311 to 325']", xlDataAndLabel, True

    ' ActiveSheet.PivotTables("PivotTable1").PivotSelect _
    "'Day Grouping2'['266 to 280':'341 to 355']", xlDataAndLabel, True
    ' Selection.Group
    ' ActiveSheet.PivotTables("PivotTable1").PivotFields("Day Grouping2").PivotItems( _
    "Group5").Caption = "Expiring 9 to 12 months"
    Range("F4").Select
    ' ActiveSheet.PivotTables("PivotTable1").PivotFields("Day Grouping2").PivotItems( _
    "Expiring 9 to 12 months").ShowDetail = False
    Range("G4").Select
    ' ActiveSheet.PivotTables("PivotTable1").PivotFields("Day Grouping2").PivotItems( _
    "355+").Caption = "Expiring beyond 12 months"
    Range("G4").Select
    ' ActiveSheet.PivotTables("PivotTable1").PivotFields("Day Grouping2").PivotItems( _
    "Expiring beyond 12 months").ShowDetail = False
    Columns("B:B").ColumnWidth = 19.71
    Columns("C:C").ColumnWidth = 14.14
    Columns("D").ColumnWidth = 13
    Columns("E:E").ColumnWidth = 13.57
    Columns("F:F").ColumnWidth = 13.29

    Columns("G:G").ColumnWidth = 18




    Rows("1:3").Select
    Selection.Insert Shift:=xlDown
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight


    'insert control panel
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Control Panel"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Close Rate"
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "Upsell %"
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "Show Rate"
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "Upsell $"
    Range("B1:B2").Select
    With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlBottom
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
    End With
    Selection.Merge
    With Selection.Font
    .Name = "Calibri"
    .Size = 20
    .Strikethrough = False
    .Superscript = False
    .Subscript = False
    .OutlineFont = False
    .Shadow = False
    .Underline = xlUnderlineStyleNone
    .ThemeColor = xlThemeColorLight1
    .TintAndShade = 0
    .ThemeFont = xlThemeFontMinor
    End With
    Selection.Font.Bold = True
    Range("D12").Select
    With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = -0.249977111117893
    .PatternTintAndShade = 0
    End With
    Range("F1:F2").Select
    With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = -0.149998474074526
    .PatternTintAndShade = 0
    End With
    Range("D12").Select
    With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = -0.149998474074526
    .PatternTintAndShade = 0
    End With
    Range("B1:F2").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
    End With


    Range("D12,F1").Select
    Range("F1").Activate
    Selection.Style = "Percent"
    Range("F2").Select
    Selection.Style = "Currency"


    Range("B33").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "Forecast Numbers"
    Range("C34").Select
    ActiveCell.FormulaR1C1 = "=R[-27]C"

    Range("B35").Select
    ActiveCell.FormulaR1C1 = "=R[-26]C"

    Range("B35").Select
    Selection.AutoFill Destination:=Range("b34:b58"), Type:=xlFillDefault


    Range("C34").Select
    Selection.AutoFill Destination:=Range("C34:i34"), Type:=xlFillDefault


    Rows("34:34").EntireRow.AutoFit
    Range("b34").Select
    Rows("33:34").RowHeight = 29.25
    Rows("33:34").Select
    With Selection
    .HorizontalAlignment = xlGeneral
    .VerticalAlignment = xlBottom
    .WrapText = True
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
    End With
    With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlBottom
    .WrapText = True
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
    End With
    Range("c35").Select
    ActiveCell.FormulaR1C1 = _
    "=IF(R1C4="""",R[-27]C,IF(R2C4="""",R[-27]C*R1C4,IF(R1C6="""",R[-27]C*R1C4*R2C4,IF(R2C6="""",R[-27]C*R1C4*R2C4*R1C6,TEXT(R[-26]C*R1C4*R2C4*R1C6*R2C6,""$ #,###.00"")))))"
    Range("c35").Select
    Selection.AutoFill Destination:=Range("c35:i35"), Type:=xlFillDefault
    Range("c35:i35").Select
    Selection.AutoFill Destination:=Range("c35:i58"), Type:=xlFillDefault

    Range("A35:I58").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
    Formula1:="=0"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriori ty
    With Selection.FormatConditions(1).Font
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Range("B33").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    With Selection
    .HorizontalAlignment = xlRight
    .VerticalAlignment = xlBottom
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
    End With
    Rows("33:34").Select
    Selection.Font.Bold = True
    Columns("A:B").Select
    Range("A4").Activate
    Selection.Font.Bold = True




    End Sub
    [/vba]

  2. #2
    VBAX Regular
    Joined
    May 2008
    Posts
    46
    Location
    I had some things commented out in the code on my last post, so I fixed it.

    [VBA]Sub Inventory_Sort()
    '
    ' Inventory_Sort Macro
    ' This sorts out a specific output from SAP to show our Cert Inventory in a Dynamic way.
    '
    ' Keyboard Shortcut: Ctrl+Shift+S
    '
    Application.ScreenUpdating = False



    Windows("Test Inventory.XLS").Activate
    Rows("1:4").Select
    Selection.Delete Shift:=xlUp
    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
    Selection.End(xlDown).Select
    Range("A2").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    ActiveWorkbook.Worksheets("Test Inventory").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Test Inventory").Sort.SortFields.Add Key:=Range( _
    "D"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
    With ActiveWorkbook.Worksheets("Test Inventory").Sort
    .SetRange Range("A:K")
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
    End With
    Range("A1").Select
    Cells.Find(What:="sold", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
    :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
    False, SearchFormat:=False).Activate
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.ClearContents
    Selection.End(xlUp).Select
    Selection.End(xlUp).Select

    Dim Counter, KillOn
    KillOn = False
    Counter = 2
    Do While (Counter <= 500000) And (KillOn = False)
    Range("C" & Counter).Select
    If IsEmpty(ActiveCell) Then
    KillOn = True

    Else: Counter = Counter + 1
    End If
    Loop
    Counter = Counter - 1


    'Insert Column to Find Days to Expiration
    Columns("D").Select
    Range("D1").Activate
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "Days to Expiration"
    Range("D").Select
    Selection.NumberFormat = "0"
    With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlBottom
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
    End With




    Range("d2").Select
    ActiveCell.FormulaR1C1 = "=RC[+1]-today()"
    Range("D2" & Counter).Select
    Selection.FillDown
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Columns("D").EntireColumn.AutoFit
    Columns("E:E").EntireColumn.AutoFit


    'Insert Column to Find a Description of what type of cert
    Columns("D").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "Material Description"
    Range("D2").Select
    ActiveCell.FormulaR1C1 = _
    "=VLOOKUP(RC3,'[Inventory Sort Macro.xlsm]Sheet1'!R3C1:R28C2,2,0)"
    Range("D2" & Counter).Select
    Selection.FillDown
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Columns("D").EntireColumn.AutoFit


    'Insert Column to Find Market
    Columns("L:L").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("L1").Select
    ActiveCell.FormulaR1C1 = "Market"
    Range("L2").Select
    ActiveCell.FormulaR1C1 = _
    "=VLOOKUP(RC11,'[Inventory Sort Macro.xlsm]Sheet1'!R31C1:R41493C3,3,FALSE)"
    Range("L2:L" & Counter).Select
    Selection.FillDown
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Columns("L:L").EntireColumn.AutoFit

    'Insert Column with number of certs to calculate dollar value
    Range("N1").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "Number of Certs"
    Range("N2").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("N2:N" & Counter).Select
    Selection.FillDown

    'Insert column to Group number of days to expiration

    Columns("F:F").Select
    Selection.Insert Shift:=xlToRight
    Range("F1").Select
    ActiveCell.FormulaR1C1 = "Day Grouping"
    Range("F2").Select
    ActiveCell.FormulaR1C1 = _
    "=IF(RC[-1]<-180,""-000000180+"",IF(AND(RC[-1]>=-180,RC[-1]<-150),""-00000180 to -151"",IF(AND(RC[-1]>=-150,RC[-1]<-120),""-0000150 to -121"",IF(AND(RC[-1]>=-120,RC[-1]<-90),""-0000120 to -91"",IF(AND(RC[-1]>=-90,RC[-1]<-60),""-000090 to -61"",IF(AND(RC[-1]>=-60,RC[-1]<-30),""-000060 to -31"",IF(AND(RC[-1]>=-30,RC[-1]<0),""-00030 to 0"",IF(AND(RC[-1]>=0,RC[-1]<16),""001 to 15"",IF(AND(RC[-1]>=16,RC[-1]<31),""016 to 30"",IF(AND(RC[-1]>=31,RC[-1]<46),""031 to 45"",IF(AND(RC[-1]>=46,RC[-1]<61),""046 to 60"",IF(AND(RC[-1]>=61,RC[-1]<76),""061 to 75"",IF(AND(RC[-1]>=76,RC[-1]<91),""076 to 90"",IF(AND(RC[-1]>=91,RC[-1]<106),""091 to 105"",IF(AND(RC[-1]>=106,RC[-1]<121),""106 to 120"",IF(AND(RC[-1]>=121,RC[-1]<136),""121 to 135"",IF(AND(RC[-1]>=136,RC[-1]<151),""136 to 150"",IF(AND(RC[-1]>=151,RC[-1]<166),""151 to 165"",IF(AND(RC[-1]>=166,RC[-1]<181),""165 to 180"",IF(AND(RC[-1]>=181,RC[-1]<196),""181 to 195""," & _
    "IF(AND(RC[-1]>=196,RC[-1]<211),""196 to 210"",IF(AND(RC[-1]>=211,RC[-1]<226),""211 to 225"",IF(AND(RC[-1]>=226,RC[-1]<241),""226 to 240"",IF(AND(RC[-1]>=241,RC[-1]<266),""241 to 265"",IF(AND(RC[-1]>=266,RC[-1]<281),""266 to 280"",IF(AND(RC[-1]>=281,RC[-1]<296),""281 to 295"",IF(AND(RC[-1]>=296,RC[-1]<311),""296 to 310"",IF(AND(RC[-1]>=311,RC[-1]<326),""311 to 325"",IF(AND(RC[-1]>=326,RC[-1]<341),""326 to 340"",IF(AND(RC[-1]>=341,RC[-1]<356),""341 to 355"",""355+""))))))))))))))))))))))))))))))"



    Range("F2:F" & Counter).Select
    Selection.FillDown
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Columns("F:F").EntireColumn.AutoFit

    'Create Pivot Table

    Range("A1:O" & Counter).Select
    Sheets.Add



    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
    "Test Inventory!R1C1:R1048576C15", Version:=xlPivotTableVersion12). _
    CreatePivotTable TableDestination:="Sheet1!R3C1", TableName:="CertInventory" _
    , DefaultVersion:=xlPivotTableVersion12
    Sheets("Sheet1").Select
    Sheets("Sheet1").Name = "Inventory Pivot Table"


    Sheets("Inventory Pivot Table").Select
    Cells(3, 1).Select
    ActiveWorkbook.ShowPivotTableFieldList = True
    With ActiveSheet.PivotTables("CertInventory").PivotFields("Material Description")
    .Orientation = xlRowField
    .Position = 1
    End With
    With ActiveSheet.PivotTables("CertInventory").PivotFields("Market")
    .Orientation = xlRowField
    .Position = 2
    End With
    With ActiveSheet.PivotTables("CertInventory").PivotFields("Day Grouping")
    .Orientation = xlColumnField
    .Position = 1
    End With
    ActiveSheet.PivotTables("CertInventory").AddDataField ActiveSheet.PivotTables( _
    "CertInventory").PivotFields("Material"), "Sum of Material", xlSum
    With ActiveSheet.PivotTables("CertInventory").PivotFields("Sum of Material")
    .Caption = "Count of Material"
    .Function = xlCount

    End With


    With ActiveSheet.PivotTables("CertInventory").PivotFields( _
    "Material Description")
    '.PivotItems("#N/A").Visible = False
    .PivotItems("(blank)").Visible = False
    End With
    With ActiveSheet.PivotTables("CertInventory").PivotFields("Market")
    .PivotItems("#N/A").Visible = False
    .PivotItems("(blank)").Visible = False
    End With
    With ActiveSheet.PivotTables("CertInventory").PivotFields("Day Grouping")
    .PivotItems("(blank)").Visible = False
    End With
    Range("B6").Select
    ActiveWindow.FreezePanes = True

    ActiveSheet.PivotTables("CertInventory").TableStyle2 = "PivotStyleDark23"
    ActiveWorkbook.ShowPivotTableFieldList = False
    Range("B3").Select
    ActiveSheet.PivotTables("CertInventory").CompactLayoutColumnHeader = _
    "Days to Expiration"
    Range("B4").Select
    Columns("B:B").EntireColumn.AutoFit


    'Add another sheet to run a forecast on


    Range("A1").Select
    ActiveSheet.PivotTables("CertInventory").MergeLabels = True
    Range("B5").Select
    ActiveSheet.PivotTables("CertInventory").DataPivotField.PivotItems( _
    "Count of Material").Caption = "# of Certs"
    Range("C5").Select

    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets("Sheet2").Select
    Sheets("Sheet2").Name = "Inventory Forecast Control"

    Range("A3").Select
    ActiveCell.FormulaR1C1 = "='Inventory Pivot Table'!RC"
    Range("A3").Select
    Selection.AutoFill Destination:=Range("A3:A2000"), Type:=xlFillDefault
    Range("A3:A2000").Select

    Range("A3").Select
    Selection.AutoFill Destination:=Range("A3:B3"), Type:=xlFillDefault

    Range("A4").Select
    Selection.AutoFill Destination:=Range("A4:AA4"), Type:=xlFillDefault
    Range("A4:AA4").Select
    ActiveWindow.SmallScroll ToRight:=2
    Selection.AutoFill Destination:=Range("A4:AC4"), Type:=xlFillDefault
    Range("A4:AC4").Select

    Selection.AutoFill Destination:=Range("A4:AN4"), Type:=xlFillDefault
    Range("A4:AN4").Select

    Columns("A:A").EntireColumn.AutoFit
    Columns("B:AN").Select
    Columns("B:AN").EntireColumn.AutoFit
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Close Rate"
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "Show Rate"
    Range("F1").Select
    ActiveCell.FormulaR1C1 = "Upsell %"
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "Upsell $"



    Range("B5").Select
    ActiveCell.FormulaR1C1 = _
    "=IF(R1C3="""",'Inventory Pivot Table'!RC,IF('Inventory Forecast Control'!R1C5="""",'Inventory Pivot Table'!RC*'Inventory Forecast Control'!R1C3,IF('Inventory Forecast Control'!R1C7="""",'Inventory Pivot Table'!RC*'Inventory Forecast Control'!R1C3*'Inventory Forecast Control'!R1C5,IF('Inventory Forecast Control'!R1C9="""",'Inventory Pivot Table'!RC*'Inventory Forecast Control'!R1C3*'Inventory Forecast Control'!R1C5*'Inventory Forecast Control'!R1C7,TEXT('Inventory Pivot Table'!RC*'Inventory Forecast Control'!R1C3*'Inventory Forecast Control'!R1C5*'Inventory Forecast Control'!R1C7*'Inventory Forecast Control'!R1C9,""$ #,###.00"")))))"
    Range("B6").Select


    Range("B5").Select
    Selection.AutoFill Destination:=Range("B5:AN5"), Type:=xlFillDefault
    Range("B5:AN5").Select


    Selection.AutoFill Destination:=Range("B5:AN2000"), Type:=xlFillDefault
    Range("B5:AN2000").Select

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .ColorIndex = xlAutomatic
    .TintAndShade = 0
    .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .ColorIndex = xlAutomatic
    .TintAndShade = 0
    .Weight = xlMedium
    End With
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

    Columns("A:A").Select
    Selection.Font.Bold = True
    Rows("1:4").Select
    Selection.Font.Bold = True

    Range("C1").Select
    Selection.Style = "Percent"
    With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = -0.149998474074526
    .PatternTintAndShade = 0
    End With
    Range("E1").Select
    Selection.Style = "Percent"
    With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = -0.149998474074526
    .PatternTintAndShade = 0
    End With
    Range("G1").Select
    Selection.Style = "Percent"
    With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = -0.149998474074526
    .PatternTintAndShade = 0
    End With
    Range("I1").Select
    Selection.Style = "Currency"
    With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = -0.149998474074526
    .PatternTintAndShade = 0
    End With
    Cells.Select
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
    Formula1:="=0"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriori ty
    With Selection.FormatConditions(1).Font
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Range("A1").Select

    Sheets("Inventory Pivot Table").Select
    ActiveSheet.PivotTables("CertInventory").PivotSelect "", xlDataAndLabel, True
    Selection.Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    Range("A3").Select
    ActiveSheet.Paste
    Sheets("Sheet3").Select
    Sheets("Sheet3").Name = "Dialed In Inventory"
    Application.CutCopyMode = False
    ActiveWorkbook.ShowPivotTableFieldList = True

    ActiveSheet.PivotTables("PivotTable5").Name = "PivotTable1"

    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Market")
    .Orientation = xlPageField
    .Position = 1
    End With



    ActiveWorkbook.ShowPivotTableFieldList = False
    ActiveSheet.PivotTables("PivotTable1").PivotSelect _
    "'-00000180 to -151':'-00030 to 0'", xlDataAndLabel, True
    Selection.Group
    ActiveSheet.PivotTables("PivotTable1").PivotSelect _
    "'-00000180 to -151':'-00030 to 0'", xlDataAndLabel, True
    Range("B4:E4").Select
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Day Grouping2").PivotItems( _
    "Group1").Caption = "Expired Certs up to 180 Days old"
    Range("B4").Select
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Day Grouping2").PivotItems( _
    "Expired Certs up to 180 Days old").ShowDetail = False
    ActiveSheet.PivotTables("PivotTable1").PivotSelect _
    "'Day Grouping2'['001 to 15':'076 to 90']", xlDataAndLabel, True
    Selection.Group
    Range("C4:H4").Select
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Day Grouping2").PivotItems( _
    "Group2").Caption = "Expiring in 3 Months"
    Range("C4").Select
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Day Grouping2").PivotItems( _
    "Expiring in 3 Months").ShowDetail = False
    ActiveSheet.PivotTables("PivotTable1").PivotSelect _
    "'Day Grouping2'['091 to 105':'165 to 180']", xlDataAndLabel, True
    Selection.Group
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Day Grouping2").PivotItems( _
    "Group3").Caption = "Expiring 3 to 6 months"
    Range("D4").Select
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Day Grouping2").PivotItems( _
    "Expiring 3 to 6 months").ShowDetail = False
    ActiveSheet.PivotTables("PivotTable1").PivotSelect _
    "'Day Grouping2'['181 to 195':'241 to 265']", xlDataAndLabel, True
    Selection.Group
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Day Grouping2").PivotItems( _
    "Group4").Caption = "Expiring 6 to 9 months"
    Range("E4").Select
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Day Grouping2").PivotItems( _
    "Expiring 6 to 9 months").ShowDetail = False
    ActiveSheet.PivotTables("PivotTable1").PivotSelect _
    "'Day Grouping2'['266 to 280':'311 to 325']", xlDataAndLabel, True

    ActiveSheet.PivotTables("PivotTable1").PivotSelect _
    "'Day Grouping2'['266 to 280':'341 to 355']", xlDataAndLabel, True
    Selection.Group
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Day Grouping2").PivotItems( _
    "Group5").Caption = "Expiring 9 to 12 months"
    Range("F4").Select
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Day Grouping2").PivotItems( _
    "Expiring 9 to 12 months").ShowDetail = False
    Range("G4").Select
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Day Grouping2").PivotItems( _
    "355+").Caption = "Expiring beyond 12 months"
    Range("G4").Select
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Day Grouping2").PivotItems( _
    "Expiring beyond 12 months").ShowDetail = False
    Columns("B:B").ColumnWidth = 19.71
    Columns("C:C").ColumnWidth = 14.14
    Columns("D").ColumnWidth = 13
    Columns("E:E").ColumnWidth = 13.57
    Columns("F:F").ColumnWidth = 13.29

    Columns("G:G").ColumnWidth = 18




    Rows("1:3").Select
    Selection.Insert Shift:=xlDown
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight


    'insert control panel
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Control Panel"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Close Rate"
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "Upsell %"
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "Show Rate"
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "Upsell $"
    Range("B1:B2").Select
    With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlBottom
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
    End With
    Selection.Merge
    With Selection.Font
    .Name = "Calibri"
    .Size = 20
    .Strikethrough = False
    .Superscript = False
    .Subscript = False
    .OutlineFont = False
    .Shadow = False
    .Underline = xlUnderlineStyleNone
    .ThemeColor = xlThemeColorLight1
    .TintAndShade = 0
    .ThemeFont = xlThemeFontMinor
    End With
    Selection.Font.Bold = True
    Range("D12").Select
    With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = -0.249977111117893
    .PatternTintAndShade = 0
    End With
    Range("F1:F2").Select
    With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = -0.149998474074526
    .PatternTintAndShade = 0
    End With
    Range("D12").Select
    With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = -0.149998474074526
    .PatternTintAndShade = 0
    End With
    Range("B1:F2").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
    End With


    Range("D12,F1").Select
    Range("F1").Activate
    Selection.Style = "Percent"
    Range("F2").Select
    Selection.Style = "Currency"


    Range("B33").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "Forecast Numbers"
    Range("C34").Select
    ActiveCell.FormulaR1C1 = "=R[-27]C"

    Range("B35").Select
    ActiveCell.FormulaR1C1 = "=R[-26]C"

    Range("B35").Select
    Selection.AutoFill Destination:=Range("b34:b58"), Type:=xlFillDefault


    Range("C34").Select
    Selection.AutoFill Destination:=Range("C34:i34"), Type:=xlFillDefault


    Rows("34:34").EntireRow.AutoFit
    Range("b34").Select
    Rows("33:34").RowHeight = 29.25
    Rows("33:34").Select
    With Selection
    .HorizontalAlignment = xlGeneral
    .VerticalAlignment = xlBottom
    .WrapText = True
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
    End With
    With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlBottom
    .WrapText = True
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
    End With
    Range("c35").Select
    ActiveCell.FormulaR1C1 = _
    "=IF(R1C4="""",R[-27]C,IF(R2C4="""",R[-27]C*R1C4,IF(R1C6="""",R[-27]C*R1C4*R2C4,IF(R2C6="""",R[-27]C*R1C4*R2C4*R1C6,TEXT(R[-26]C*R1C4*R2C4*R1C6*R2C6,""$ #,###.00"")))))"
    Range("c35").Select
    Selection.AutoFill Destination:=Range("c35:i35"), Type:=xlFillDefault
    Range("c35:i35").Select
    Selection.AutoFill Destination:=Range("c35:i58"), Type:=xlFillDefault

    Range("A35:I58").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
    Formula1:="=0"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriori ty
    With Selection.FormatConditions(1).Font
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Range("B33").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    With Selection
    .HorizontalAlignment = xlRight
    .VerticalAlignment = xlBottom
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
    End With
    Rows("33:34").Select
    Selection.Font.Bold = True
    Columns("A:B").Select
    Range("A4").Activate
    Selection.Font.Bold = True




    End Sub
    [/VBA]
    ________________________________________
    The more questions I ask and the more I learn, I realize that I don't know squat!!!

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •