amrita17170909
Board Regular
- Joined
- Dec 11, 2019
- Messages
- 74
- Office Version
- 2019
- 2016
- 2013
- Platform
- Windows
Hi All,
I need help with formatting of a report.
The report takes input from Table 4 and creates an "Attachment A" once the user clicks on the button to create the report.
Table 4 looks as per below:
1. It has columns from A to AA
2. Column A : Customer ID
Column B : ID Description
Column C : Grp
Column D: Prog
Column E: Prog Number
Column F to Column AA : 2020 onwards with the last column for contingency
Attachment A should look as per below:
The code which I am using at the moment is as per below:
Inspite of trying everything I don't think my program is optimized as it has been hard-coded and also very long as I have used macros to understand how I can do stuff. I am also not able to include the following things in my code:
1. Every ID in the final report needs to have a box around it so it comes across as one entity.
2. The report should show all "0"'s in the report as "-"
3. I need to include a validation rule in which if the Total is not 0 it should change the font color to red .
Thanks for help in advance.
I need help with formatting of a report.
The report takes input from Table 4 and creates an "Attachment A" once the user clicks on the button to create the report.
Table 4 looks as per below:
1. It has columns from A to AA
2. Column A : Customer ID
Column B : ID Description
Column C : Grp
Column D: Prog
Column E: Prog Number
Column F to Column AA : 2020 onwards with the last column for contingency
Attachment A should look as per below:
The code which I am using at the moment is as per below:
VBA Code:
Sub generate_report_v_4() ' step 7
Dim IDtag As String
Dim IDdesc As String
Dim LastRowNo As Long
Dim StartIDRow As Long
Dim LastIDRow As Long
Dim IDloop As Long
Dim CurrentTag As String
Dim ID20Years
Dim ID20YearsTot
Dim LbID20Years As Long
Dim UbID20Years As Long
Dim ReportRow As Long
IDtag = ""
IDdesc = ""
StartIDRow = 2
LastIDRow = 0
'Calculate the number of rows in Table 4
LastRowNo = Worksheets("Table 4").Cells(Rows.Count, 1).End(xlUp).Row
'Check if there is data in table 4
If LastRowNo < 2 Then
MsgBox "Sorry, could not find data", vbCritical, ThisWorkbook.Name
Exit Sub
Else
If Worksheets("Table 4").Range("A2").Value <> "" Then
IDtag = Worksheets("Table 4").Range("A2").Value
CurrentTag = IDtag
IDdesc = Worksheets("Table 4").Range("B2").Value
Else
MsgBox "Sorry, no data", vbCritical, ThisWorkbook.Name
Exit Sub
End If
End If
'Code for the format of the report
Call report_aesthetics_1
ReportRow = 6
'write first line
IDtag = Worksheets("Table 4").Cells(StartIDRow, 1).Value
'MsgBox (IDtag)
Worksheets("Attachment A").Cells(ReportRow, 1).Value = IDtag
Worksheets("Attachment A").Cells(ReportRow, 1).Font.Bold = True
Worksheets("Attachment A").Cells(ReportRow, 2).Value = Worksheets("Table 4").Cells(StartIDRow, 2).Value
Worksheets("Attachment A").Cells(ReportRow, 2).Font.Bold = True
Worksheets("Attachment A").Cells(ReportRow, 4).Value = Worksheets("Table 4").Cells(StartIDRow, 4).Value
Worksheets("Attachment A").Cells(ReportRow, 5).Value = Worksheets("Table 4").Cells(StartIDRow, 3).Value
ID20Years = Worksheets("Table 4").Range(Cells(StartIDRow, 6).Address, Cells(StartIDRow, 27).Address).Value
Worksheets("Attachment A").Range(Cells(ReportRow, 6).Address, Cells(ReportRow, 27).Address).Value = ID20Years
ID20YearsTot = ID20Years
LbID20Years = LBound(ID20Years, 2)
UbID20Years = UBound(ID20Years, 2)
'MsgBox (LbID20Years)
'MsgBox (UbID20Years)
'Set for next read
StartIDRow = StartIDRow + 1
CurrentTag = Worksheets("Table 4").Cells(StartIDRow, 1).Value
ReportRow = ReportRow + 1
Do While StartIDRow <= LastRowNo
Do While IDtag = CurrentTag
Worksheets("Attachment A").Cells(ReportRow, 5).Value = Worksheets("Table 4").Cells(StartIDRow, 3).Value
Worksheets("Attachment A").Cells(ReportRow, 4).Value = Worksheets("Table 4").Cells(StartIDRow, 4).Value
ID20Years = Worksheets("Table 4").Range(Cells(StartIDRow, 6).Address, Cells(StartIDRow, 27).Address).Value
'add to total
For IDloop = LbID20Years To UbID20Years
ID20YearsTot(1, IDloop) = ID20YearsTot(1, IDloop) + ID20Years(1, IDloop)
Next IDloop
Worksheets("Attachment A").Range(Cells(ReportRow, 6).Address, Cells(ReportRow, 27).Address).Value = ID20Years
StartIDRow = StartIDRow + 1
CurrentTag = Worksheets("Table 4").Cells(StartIDRow, 1).Value
ReportRow = ReportRow + 1
Loop
'Finish putting rows and add the total line
Worksheets("Attachment A").Range(Cells(ReportRow, 5).Address).Value = "TOTAL"
Worksheets("Attachment A").Range(Cells(ReportRow, 5).Address).Font.Bold = True ' Font should be bold
Worksheets("Attachment A").Range(Cells(ReportRow, 6).Address, Cells(ReportRow, 27).Address).Value = ID20YearsTot
Worksheets("Attachment A").Range(Cells(ReportRow, 6).Address, Cells(ReportRow, 27).Address).Font.Bold = True ' Font should be bold
'If ID20YearsTot < 1 Then ID20YearsTot = "-"
ReportRow = ReportRow + 1
'write first line
' StartIDRow = StartIDRow + 1
ReportRow = ReportRow + 1
IDtag = Worksheets("Table 4").Cells(StartIDRow, 1).Value
Worksheets("Attachment A").Cells(ReportRow, 1).Value = IDtag
Worksheets("Attachment A").Cells(ReportRow, 1).Font.Bold = True
'MsgBox (IDtag)
Worksheets("Attachment A").Cells(ReportRow, 2).Value = Worksheets("Table 4").Cells(StartIDRow, 2).Value
Worksheets("Attachment A").Cells(ReportRow, 2).Font.Bold = True
Worksheets("Attachment A").Cells(ReportRow, 5).Value = Worksheets("Table 4").Cells(StartIDRow, 3).Value
Worksheets("Attachment A").Cells(ReportRow, 4).Value = Worksheets("Table 4").Cells(StartIDRow, 4).Value
ID20Years = Worksheets("Table 4").Range(Cells(StartIDRow, 6).Address, Cells(StartIDRow, 27).Address).Value
Worksheets("Attachment A").Range(Cells(ReportRow, 6).Address, Cells(ReportRow, 27).Address).Value = ID20Years
ID20YearsTot = ID20Years
LbID20Years = LBound(ID20Years, 2)
UbID20Years = UBound(ID20Years, 2)
'Set for next read
StartIDRow = StartIDRow + 1
CurrentTag = Worksheets("Table 4").Cells(StartIDRow, 1).Value
ReportRow = ReportRow + 1
Loop
'change -values to ()
LastRowNo1 = Worksheets("Attachment A").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Attachment A").Range(Cells(2, 6).Address, Cells(LastRowNo1, 27).Address).NumberFormat = "#,##0;(#,##0)"
Call sum_two_columns
End Sub
Code:
Sub report_aesthetics_1() ' This is used to change the look and feel of Attachment A
' No Gridlines for the report
Worksheets("Attachment A").Activate
ActiveWindow.DisplayGridlines = False
'Add the line "Top of Defence' in the worksheet
Worksheets("Attachment A").Range("A1:J1").Select
Selection.Font.Bold = True
Selection.Font.Size = 12
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("A1:J1").Select
ActiveCell.FormulaR1C1 = "TOP"
' Add the name of the report "ATTACHMENT A - <Enter Name of Journal>"
Worksheets("Attachment A").Range("A2:J2").Select
Selection.Font.Bold = True
Selection.Font.Size = 16
Selection.Font.Color = vbRed
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("A2:J2").Select
ActiveCell.FormulaR1C1 = "ATTACHMENT A "
'Add the month and year of the report
Worksheets("Attachment A").Range("A3:J3").Select
Selection.Font.Bold = True
Selection.Font.Size = 16
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("A3:J3").Select
ActiveCell.FormulaR1C1 = "<Enter Month and Year of report>"
'Write heading
Worksheets("Attachment A").Range("A5").Value = "ID"
Worksheets("Attachment A").Range("B5").Value = "ID Description"
Worksheets("Attachment A").Range("C5").Value = "Journal Description"
Worksheets("Attachment A").Range("D5").Value = "Program"
Worksheets("Attachment A").Range("E5").Value = "Gr"
Worksheets("Attachment A").Range("F5").Value = "2019-2020"
Worksheets("Attachment A").Range("G5").Value = "2020-2021"
Worksheets("Attachment A").Range("H5").Value = "2021-2022"
Worksheets("Attachment A").Range("I5").Value = "2022-2023"
Worksheets("Attachment A").Range("J5").Value = "2023-2024"
Worksheets("Attachment A").Range("K5").Value = "2024-2025"
Worksheets("Attachment A").Range("L5").Value = "2025-2026"
Worksheets("Attachment A").Range("M5").Value = "2026-2027"
Worksheets("Attachment A").Range("N5").Value = "2027-2028"
Worksheets("Attachment A").Range("O5").Value = "2028-2029"
Worksheets("Attachment A").Range("P5").Value = "2029-2030"
Worksheets("Attachment A").Range("Q5").Value = "2030-2031"
Worksheets("Attachment A").Range("R5").Value = "2031-2032"
Worksheets("Attachment A").Range("S5").Value = "2032-2033"
Worksheets("Attachment A").Range("T5").Value = "2033-2034"
Worksheets("Attachment A").Range("U5").Value = "2034-2035"
Worksheets("Attachment A").Range("V5").Value = "2035-2036"
Worksheets("Attachment A").Range("W5").Value = "2036-2037"
Worksheets("Attachment A").Range("X5").Value = "2037-2038"
Worksheets("Attachment A").Range("Y5").Value = "2038-2039"
Worksheets("Attachment A").Range("Z5").Value = "2039-2040"
Worksheets("Attachment A").Range("AA5").Value = "Contingency"
Worksheets("Attachment A").Range("AB5").Value = "Total 20 Years (Ex Cont.)"
Worksheets("Attachment A").Range("AC5").Value = "Total 20 Years (Inc Cont.)"
'Format the headings
'Font should be bold
Range("A5:AC5").Select
Selection.Font.Bold = True
Columns("B:B").ColumnWidth = 44.14
Columns("B:B").ColumnWidth = 49
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark2
.TintAndShade = 0
.PatternTintAndShade = 0
End With
' Row height adjustment
Range("A5:AC5").Select
Selection.RowHeight = 70.5
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
'Making sure the headings are in the middle
Range("A5:AC5").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
End Sub
Inspite of trying everything I don't think my program is optimized as it has been hard-coded and also very long as I have used macros to understand how I can do stuff. I am also not able to include the following things in my code:
1. Every ID in the final report needs to have a box around it so it comes across as one entity.
2. The report should show all "0"'s in the report as "-"
3. I need to include a validation rule in which if the Total is not 0 it should change the font color to red .
Thanks for help in advance.