Convering Recorded Excel Macro into VBA

P

purceld2

Well-known Member
Joined
Aug 18, 2005
Messages
586
Office Version
  1. 2013
Platform
  1. Windows
Hi

I have recorded a Excel Macro which works fine.

But I decided to amend the code a small bit to move the total boxes down a few rows to make room for when additional rows are added, this is because the recorded macro hard coded the total boxes to row 106 so when you have more 106 lines of data it messes the total boxes up.

I know I could amended the code to find the last row and put the totol boxes just below but my VBA skills are not that good. So my work around is to move the total boxes down 1000 to cater for added lines and manually delete the rows once the macro is run. In furture I would add a bit of VBA to delete the rows automatically.

I am aware there is a much better way of doing this it but as I said I am just learning VBA

This amended code works just for one thing the SUMPRODUCTS are not working.

I would be most gratefull if somebody amend for me (Lines in question below)


Code: 
Range("B1107").Select
    ActiveCell.FormulaR1C1 = _
        "=SUMPRODUCT(--(R[-104]C[2]:R[-5]C[2]=90),R[-104]C[7]:R[-5]C[7])"
    Range("B1108").Select
    ActiveCell.FormulaR1C1 = _
        "=SUMPRODUCT(--(R[-105]C[2]:R[-6]C[2]=60),R[-105]C[7]:R[-6]C[7])"
    Range("B1109").Select
    ActiveCell.FormulaR1C1 = _
        "=SUMPRODUCT(--(R[-106]C[2]:R[-7]C[2]=30),R[-106]C[7]:R[-7]C[7])"
    Range("B1110").Select
    ActiveCell.FormulaR1C1 = _
        "=SUMPRODUCT(--(R[-107]C[2]:R[-8]C[2]=10),R[-107]C[7]:R[-8]C[7])"

Full Code Beloe


Code: 
Sub Format()


'Copy Selected Columns


Sheets("Salesforce Pipeline").Columns(1).Copy Destination:=Sheets("Sheet2").Columns(1)
Sheets("Salesforce Pipeline").Columns(14).Copy Destination:=Sheets("Sheet2").Columns(2)
Sheets("Salesforce Pipeline").Columns(7).Copy Destination:=Sheets("Sheet2").Columns(3)
Sheets("Salesforce Pipeline").Columns(8).Copy Destination:=Sheets("Sheet2").Columns(4)
Sheets("Salesforce Pipeline").Columns(9).Copy Destination:=Sheets("Sheet2").Columns(5)
Sheets("Salesforce Pipeline").Columns(10).Copy Destination:=Sheets("Sheet2").Columns(6)
Sheets("Salesforce Pipeline").Columns(11).Copy Destination:=Sheets("Sheet2").Columns(7)
Sheets("Salesforce Pipeline").Columns(12).Copy Destination:=Sheets("Sheet2").Columns(8)
Sheets("Salesforce Pipeline").Columns(4).Copy Destination:=Sheets("Sheet2").Columns(9)


'Filter Keep Only Uk Employees


ActiveWorkbook.Sheets("Sheet2").Activate


Range("A1:I1").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$I$188").AutoFilter Field:=8, Criteria1:=Array( _
        "Des Purcell", "John Smith", "Tom Dells", "Ian wells", "Ann Right"), _
        Operator:=xlFilterValues
    Range("A2:I8").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.EntireRow.Delete
    Range("A90:I90").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.EntireRow.Delete
    Selection.AutoFilter


'By Sort Fiscal Period & Probability


Range("B16").Select
    ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Add Key:=Range("E2:E89") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Add Key:=Range("D2:D89") _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet2").Sort
        .SetRange Range("A1:I89")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With


'Condistional Formating


Const TEST_COLUMN As String = "D" '<=== change to suit
    Dim LastRow As Long
    Dim cell As Range
        
    With Worksheets("Sheet2")
        LastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
         
        Range("D2:D" & LastRow).Select
         
        For Each cell In Selection
            If cell.Value = 90 Then
                cell.EntireRow.Interior.ColorIndex = 3
                ElseIf cell.Value = 60 Then
                cell.EntireRow.Interior.ColorIndex = 45
            ElseIf cell.Value = 30 Then
                cell.EntireRow.Interior.ColorIndex = 4
            ElseIf cell.Value = 10 Then
                cell.EntireRow.Interior.ColorIndex = 34
            Else
                cell.EntireRow.Interior.ColorIndex = xlNone
            End If
        Next
    End With
    
    Columns("J:J").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.ClearFormats
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    
'Format Sheet Part 1


    Columns("C:H").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("I2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.NumberFormat = "$#,##0"
    Columns("C:I").Select
    Selection.ColumnWidth = 22
    Range("D6").Select


'Create Subtotals


    Selection.Subtotal GroupBy:=4, Function:=xlSum, _
    TotalList:=Array(9)
    
'Format Sheet Part 2


    ActiveWindow.SmallScroll Down:=13
    Range("A1:I209").Select
    Range("A209").Activate
    Selection.Rows.Ungroup
    
    Selection.Rows.Ungroup
    
    Range("A1:I1").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$I$101").AutoFilter Field:=4, Criteria1:=Array( _
        "10 Total", "30 Total", "60 Total", "90 Total"), Operator:=xlFilterValues
    Range("A4:I102").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("I4:I102").Select
    Selection.Font.Bold = True
    ActiveSheet.Range("$A$1:$I$101").AutoFilter Field:=4
    Selection.AutoFilter
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown
    Range("H1:I1").Select
    Rows("1:1").RowHeight = 30
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
    Range("A1:G1").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
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Selection.Font.Bold = True
    With Selection.Font
        .Name = "Calibri"
        .Size = 26
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    With Selection.Font
        .Name = "Calibri"
        .Size = 24
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "=TODAY()"
    Selection.Cut
    Application.CutCopyMode = False
    Selection.Cut
    Range("I1").Select
    ActiveSheet.Paste
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "Date"
    Range("H1").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection.Font
        .Name = "Calibri"
        .Size = 24
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Range("I1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection.Font
        .Name = "Calibri"
        .Size = 24
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    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
    With Selection.Font
        .Name = "Calibri"
        .Size = 18
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Range("H1").Select
    With Selection.Font
        .Name = "Calibri"
        .Size = 18
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Rows("2:2").RowHeight = 29.25
    Range("A1:I2").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent5
        .TintAndShade = 0.399975585192419
        .PatternTintAndShade = 0
    End With
    Range("A1:I1").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("A2:I2").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("H1:I1").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("L14").Select
    
    Range("H1:I1").Select
    Selection.Font.Bold = True
    
'Insert Totals


Columns("A:B").Select
    Range("B2").Activate
    Selection.ColumnWidth = 28.71
    Range("I3").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWindow.LargeScroll Down:=1
    Range("A1106").Select
    ActiveCell.FormulaR1C1 = "TOTAL IN PIPELINE"
    Range("A1106:B1106").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
    Range("A1107").Select
    ActiveCell.FormulaR1C1 = "0.9"
    Range("A1108").Select
    ActiveCell.FormulaR1C1 = "0.6"
    Range("A1109").Select
    ActiveCell.FormulaR1C1 = "0.3"
    Range("A1110").Select
    ActiveCell.FormulaR1C1 = "0.1"
    Range("A1107:A1110").Select
    Selection.Style = "Percent"
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("A1111").Select
    ActiveCell.FormulaR1C1 = "TOTAL"
    Range("A1111").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("B1107").Select
    ActiveCell.FormulaR1C1 = _
        "=SUMPRODUCT(--(R[-104]C[2]:R[-5]C[2]=90),R[-104]C[7]:R[-5]C[7])"
    Range("B1108").Select
    ActiveCell.FormulaR1C1 = _
        "=SUMPRODUCT(--(R[-105]C[2]:R[-6]C[2]=60),R[-105]C[7]:R[-6]C[7])"
    Range("B1109").Select
    ActiveCell.FormulaR1C1 = _
        "=SUMPRODUCT(--(R[-106]C[2]:R[-7]C[2]=30),R[-106]C[7]:R[-7]C[7])"
    Range("B1110").Select
    ActiveCell.FormulaR1C1 = _
        "=SUMPRODUCT(--(R[-107]C[2]:R[-8]C[2]=10),R[-107]C[7]:R[-8]C[7])"
    Range("B1107:B1111").Select
    Selection.NumberFormat = "$#,##0.00"
    Range("B111").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-4]C:R[-1]C)"
    Range("A1111:B1111").Select
    Selection.Font.Bold = True
    Range("A1106:B1111").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("C1112").Select
    
    Range("D3").Select
    Selection.Copy
    
    Range("A1107:B1107").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    
    Range("D6").Select
    Selection.Copy
    
    Range("A1108:B1108").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    
    Range("D9").Select
    Selection.Copy
    
    Range("A1109:B1109").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    
    Range("D21").Select
    Selection.Copy
    
    Range("A1110:B1110").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A1107:A1110").Select
    Selection.NumberFormat = "0.00%"
    Selection.NumberFormat = "0%"
    Range("B1107:B1110").Select
    Selection.NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
    Range("I3:I103").Select
    Range("I103").Activate
    Selection.NumberFormat = "#,##0"
    Selection.NumberFormat = "$#,##0.00"
    Selection.NumberFormat = "$#,##0.00"
    
    Range("B125").Select
    
    Range("A1107:B1110").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("B1111").Select
    Selection.NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
    Range("I3:I103").Select
    Range("I103").Activate
    Selection.NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
    
    Range("A3").Select


'Add Fiscal Totals


    Range("I3").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWindow.LargeScroll Down:=1
    Range("D1106").Select
    ActiveCell.FormulaR1C1 = "FISCAL PERIODS"
    Range("D1106:F1106").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
    Range("D1107").Select
    ActiveCell.FormulaR1C1 = "Q1-2013"
    Range("D1108").Select
    ActiveCell.FormulaR1C1 = "Q2-2013"
    Range("D1109").Select
    ActiveCell.FormulaR1C1 = "Q3-2013"
    Range("D1110").Select
    ActiveCell.FormulaR1C1 = "Q4-2013"
    Range("D1111").Select
    ActiveCell.FormulaR1C1 = "Q1-2014"
    Range("E1107").Select
    ActiveCell.FormulaR1C1 = "Jan - March 2013"
    Range("E1108").Select
    ActiveCell.FormulaR1C1 = "April - June 2013"
    Range("E1109").Select
    ActiveCell.FormulaR1C1 = "July - Sept 2013"
    Range("E1110").Select
    ActiveCell.FormulaR1C1 = "Sept - Dec 2013"
    Range("E1111").Select
    ActiveCell.FormulaR1C1 = "Jan - March 2013"
    Range("F1107").Select
    ActiveCell.FormulaR1C1 = _
        "=SUMPRODUCT(--(R[-104]C[-1]:R[-5]C[-1]=""Q1-2013""),R[-104]C[3]:R[-5]C[3])"
    Range("F1108").Select
    ActiveCell.FormulaR1C1 = _
        "=SUMPRODUCT(--(R[-105]C[-1]:R[-6]C[-1]=""Q2-2013""),R[-105]C[3]:R[-6]C[3])"
    Range("F1109").Select
    ActiveCell.FormulaR1C1 = _
        "=SUMPRODUCT(--(R[-106]C[-1]:R[-7]C[-1]=""Q3-2013""),R[-106]C[3]:R[-7]C[3])"
    Range("F1110").Select
    ActiveCell.FormulaR1C1 = _
        "=SUMPRODUCT(--(R[-107]C[-1]:R[-8]C[-1]=""Q4-2013""),R[-107]C[3]:R[-8]C[3])"
    Range("F1111").Select
    ActiveCell.FormulaR1C1 = _
        "=SUMPRODUCT(--(R[-108]C[-1]:R[-9]C[-1]=""Q1-2014""),R[-108]C[3]:R[-9]C[3])"
    Range("D1112").Select
    ActiveCell.FormulaR1C1 = "TOTAL"
    Range("F1112").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-5]C:R[-1]C)"
    Range("F1107:F1112").Select
    Selection.NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
    Range("D1112:F1112").Select
    Selection.Font.Bold = True
    Range("D1106:F1112").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("I124").Select


End Sub
 

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.
You must log in or register to reply here.

Similar threads

K
  • Solved
formating question
Replies
3
Views
270
Micron
M
L
  • Locked
  • Question
Help Cleaning Up Code
Replies
2
Views
548
RoryA
RoryA
K
  • Solved
create a button that do actions
2 3
Replies
22
Views
1K
kerm007
K
P
  • Question
Issue with button not running in spread sheet only in test mode
Replies
1
Views
340
6StringJazzer
6StringJazzer
J
  • Question
Issue with Macros and renaming files
Replies
6
Views
901
kevin9999
K

Forum statistics

Threads
1,221,418
Messages
6,159,791
Members
451,589
Latest member
Harold14

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