Ragnar1211
Well-known Member
- Joined
- Jul 10, 2008
- Messages
- 572
Hello everyone,
I am looking for some feedback on the code I have written. It is my first attempt at using arrays in code for the purpose of accumulating data, and subesequently using the same data to create a report.
My code below looks at a table that is 10 columns wide and reads all of the data into 10 different arrays - this is where feedback may be useful, should I have used a multi dimensional array (if so show me how please).
After it reads the data into the arrays it looks at the first array and finds the unique items in that array, which are then used to create a nice report outlined by the groupings.
Once again any feedback on ways to improve the code would be great - learning lots.
Thanks
I am looking for some feedback on the code I have written. It is my first attempt at using arrays in code for the purpose of accumulating data, and subesequently using the same data to create a report.
My code below looks at a table that is 10 columns wide and reads all of the data into 10 different arrays - this is where feedback may be useful, should I have used a multi dimensional array (if so show me how please).
After it reads the data into the arrays it looks at the first array and finds the unique items in that array, which are then used to create a nice report outlined by the groupings.
Once again any feedback on ways to improve the code would be great - learning lots.
Thanks
Code:
Option Explicit
Sub investment1()
'Macro to create investment portfolio report - By Gerry on March 9, 2009
Dim lr As Long, i As Long, j As Long, k As Long, l As Long
Dim CUname As String, RPdate As String
Dim grp1() As Variant, grp2() As Variant, grp3() As Variant, grp4() As Variant
Dim grp5() As Variant, grp6() As Variant, grp7() As Variant, grp8() As Variant
Dim grp9() As Variant, grp10() As Variant
Dim hdg() As Variant, hdg1 As Long
Application.ScreenUpdating = False
'Get the relevant data - 10 columns of data, 1 array for each column
With Worksheets("Inputs")
lr = .Cells(.Rows.Count, 1).End(xlUp).Row
ReDim grp1(1 To lr), grp2(1 To lr), grp3(1 To lr), grp4(1 To lr), grp5(1 To lr)
ReDim grp6(1 To lr), grp7(1 To lr), grp8(1 To lr), grp9(1 To lr), grp10(1 To lr)
For i = 8 To lr
grp1(i) = .Cells(i, 1).Value
grp2(i) = .Cells(i, 2).Value
grp3(i) = .Cells(i, 3).Value
grp4(i) = .Cells(i, 4).Value
grp5(i) = .Cells(i, 5).Value
grp6(i) = .Cells(i, 6).Value
grp7(i) = .Cells(i, 7).Value
grp8(i) = .Cells(i, 8).Value
grp9(i) = .Cells(i, 9).Value
grp10(i) = .Cells(i, 10).Value
Next
'Get the CU name and report date
CUname = .Range("A1").Value
RPdate = Format(.Range("C5").Value, "MMMM DD, YYYY")
End With
'Get the category headings and count using custom function called UniqueItems
hdg = UniqueItems(grp1, False)
hdg1 = UniqueItems(grp1)
Sheets.Add
ActiveSheet.Name = "newSht"
'Set Starting row for report
k = 7
'Put the data into report format
For i = 1 To hdg1 'counter for each group heading
Cells(k, 1).Value = hdg(i)
Cells(k, 4).Value = "Start"
Cells(k, 5).Value = "Maturity"
Cells(k, 6).Value = "Face Value"
Cells(k, 7).Value = "Amortization"
Cells(k, 8).Value = "Book Value"
Cells(k, 9).Value = "Yield"
Cells(k, 10).Value = "Bond Rating"
l = k 'Counter for top row of group
For j = 1 To UBound(grp1) 'search array for data that matches heading
If grp1(j) = hdg(i) Then
k = k + 1
Cells(k, 2).Value = grp2(j)
Cells(k, 3).Value = grp3(j)
Cells(k, 4).Value = grp4(j)
Cells(k, 5).Value = grp5(j)
Cells(k, 6).Value = grp6(j)
Cells(k, 7).Value = grp7(j)
Cells(k, 8).Value = grp8(j)
Cells(k, 9).Value = grp9(j)
Cells(k, 10).Value = grp10(j)
End If
Next j
'Insert Totals
k = k + 2
l = k - l - 1
Cells(k, 1).Value = hdg(i) & " Total"
Cells(k, 6).FormulaR1C1 = "=SUBTOTAL(9,R[-" & l & "]C:R[-1]C)"
Cells(k, 7).FormulaR1C1 = "=SUBTOTAL(9,R[-" & l & "]C:R[-1]C)"
Cells(k, 8).FormulaR1C1 = "=SUBTOTAL(9,R[-" & l & "]C:R[-1]C)"
Cells(k, 9).FormulaR1C1 = "=sumproduct(--(R[-" & l & "]C[-3]:R[-1]C[-3]),--(R[-" & l & "]C:R[-1]C))/RC[-3]"
'Format display
With Union(Range(Cells(k, 1), Cells(k, 10)), Range(Cells(k - l - 1, 1), Cells(k - l - 1, 10)))
.Font.Bold = True
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With
'Put two blank rows in between
k = k + 3
Next i
'Finish Formatting - make it look pretty
Range("F:H").NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""??_);_(@_)"
Range("I:I").NumberFormat = "0.00%"
Columns.AutoFit
Columns("A:A").ColumnWidth = 4
Range("A1").Value = CUname
Range("A2").Value = "Board Report on Investment Management"
Range("A3").Value = "Part 4 - Investment Quality"
Range("A4").Value = RPdate
With Range("A1:J4")
.HorizontalAlignment = xlCenterAcrossSelection
.Font.Bold = True
End With
ActiveWindow.DisplayGridlines = False
Application.ScreenUpdating = True
End Sub
