This is my first "developped-from-scratch" VBA script.
Sub FormatReport()
'Add total footer
Dim lastRow As Integer
Dim lastCol As Integer
lastRow = [A65536].End(xlUp).Row + 1
lastCol = [VV1].End(xlToLeft).Column
Range(Cells(lastRow, 1), Cells(lastRow, 1)).Value = "TOTAL"
Dim col As Integer
col = 2
Do Until col = lastCol
Range(Cells(lastRow, col), Cells(lastRow, col)).Select
R = ActiveCell.Row
C = ActiveCell.Column
If IsNumeric(Cells(2, C)) And Not IsEmpty(Cells(2, c)) Then
ActiveCell.Value = Application.sum(Range(Cells(2, C), Cells(R, C)))
End If
col = col + 1
Loop
'Format cells
col = 2
Do Until col = lastCol
'Range("B2", Cells(lastRow, lastCol)).Select
Range(Cells(2, col), Cells(lastRow, col)).Select
If IsNumeric(Cells(2, col)) Then
Selection.NumberFormat = "$#,##0"
End If
If IsDate(Cells(2, col)) Then
Selection.NumberFormat = "m/d/yyyy"
End If
Cells.EntireColumn.AutoFit
col = col + 1
Loop
'Format footer
Range(Cells(lastRow, 1), Cells(lastRow, lastCol)).Select
With Selection.Interior
.ColorIndex = 3
.Pattern = xlSolid
End With
Selection.Font.ColorIndex = 2
Selection.Font.Bold = True
'Format header
Range(Cells(1, 1), Cells(1, lastCol)).Select
Selection.Font.Bold = True
With Selection.Interior
.ColorIndex = 3
.Pattern = xlSolid
End With
Selection.Font.ColorIndex = 2
Range(Cells(1, 2), Cells(1, lastCol)).Select
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
'Insert new row
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Range(Cells(1, 1), Cells(1, lastCol)).Select
With Selection.Interior
.ColorIndex = 3
.Pattern = xlSolid
End With
Selection.Font.ColorIndex = 2
Selection.Font.Bold = True
Range(Cells(1, 1), Cells(1, lastCol)).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
'Add header to new row
Dim month As String
month = Application.InputBox("Enter Month and Year for the report header", "Enter Date", "January 2009")
Range(Cells(1, 1), Cells(1, lastCol)).Select
ActiveCell.FormulaR1C1 = "REPORT FOR " + month
Range(Cells(1, 1), Cells(1, lastCol)).Select
With Selection.Font
.Name = "Arial"
.Size = 14
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
End With
End Sub
No comments:
Post a Comment