Solved: Process Summary Report from Array of Data

[youngmcc]

Hello,

I'm wondering if anyone can help me.

I've ran through various processes to collect data from various places into an array, however, I now need to put this data back into a report in specific format.

I'm having a bit of a mind blank just now so hopefully this a straight forward case to solve.

Heres a cut down example of my array.


marrInstruments (0 to 8, 0 to 6)

The data that I am interested in outputting is stored in members 0, 1 and 8.


marrInstruments(0, 0) - Brian Report 1
marrInstruments(0, 1) - Brian Report 1
marrInstruments(0, 2) - Brian Report 1
marrInstruments(0, 3) - Brian Report 2
marrInstruments(0, 4) - Brian Report 2
marrInstruments(0, 5) - Brian Report 2
marrInstruments(0, 6) - Brian Report 2

marrInstruments(1, 0) - Example Type 1
marrInstruments(1, 1) - Example Type 2
marrInstruments(1, 2) - Example Type 3
marrInstruments(1, 3) - New Example Type 1
marrInstruments(1, 4) - New Example Type 2
marrInstruments(1, 5) - New Example Type 3
marrInstruments(1, 6) - New Example Type 4

marrInstruments(8, 0) - 0
marrInstruments(8, 1) - 0
marrInstruments(8, 2) - 300,000
marrInstruments(8, 3) - 100,000
marrInstruments(8, 4) - 0
marrInstruments(8, 5) - (150,000)
marrInstruments(8, 6) - 100

Item 1 of my array is headers so I only want to output these unique ones.

Item 2 of my array I need to output all as with Item 3.

So my output report would look like this:

Brian Report 1

Example Type 1 - 0
Example Type 2 - 0
Example Type 3 - 300,000

Brian Report 1 Total - 300,000


Brian Report 2

New Example Type 1 - 100,000
New Example Type 2 - 0
New Example Type 3 - (150,000)
New Example Type 4 - 100

Brian Report 2 Total - (49,900)

Cheers

McCrimmon

[Bob Phillips]

Dim repOK As Boolean
Dim prevReport As String
Dim totalReport As Double
Dim nextRow As Long
Dim i As Long, ii As Long

ReDim marrReports(1 To 3, 1 To 1)

For i = LBound(marrInstruments, 2) To UBound(marrInstruments, 2)

If marrInstruments(0, i) <> prevReport Then

prevReport = marrInstruments(0, i)
nextRow = nextRow + 1
With Cells(nextRow, "A")

.Value = prevReport
.Font.Bold = True
End With

nextRow = nextRow + 2
ii = i
totalReport = 0
repOK = True
Do

If ii <= UBound(marrInstruments, 2) Then

If marrInstruments(0, ii) <> prevReport Then

repOK = False
End If
Else

repOK = False
End If

If repOK Then

Cells(nextRow, "A") = marrInstruments(1, ii)
Cells(nextRow, "B") = marrInstruments(8, ii)
totalReport = totalReport + marrInstruments(8, ii)
ii = ii + 1
nextRow = nextRow + 1
End If
Loop Until Not repOK

nextRow = nextRow + 1
With Cells(nextRow, "A")

.Value = prevReport & " Total"
.Font.Bold = True
End With
Cells(nextRow, "B").Value = totalReport

i = ii - 1
nextRow = nextRow + 1
End If
Next i

Columns("A:B").AutoFit

[youngmcc]

Hey,

Sorry for the late reply.
I have been away on holiday.

Thanks for your response.

My criteria has changed a bit and I now need to do the following.

If the totals is zero and is made up of all members having zero values then these should be ignored on the summary report.

If, however, the totals is zero but made up of a positive and negative balancing each other off then these should be included on the report.

For example on Report 4 I will have a totals of zero, however, this is made up of a positive 100 value and a negative 100 value.



ReDim marrInstruments(0 To 8, 0 To 10)

marrInstruments(0, 0) = "Brian Report 1"
marrInstruments(0, 1) = "Brian Report 1"
marrInstruments(0, 2) = "Brian Report 1"
marrInstruments(0, 3) = "Brian Report 2"
marrInstruments(0, 4) = "Brian Report 2"
marrInstruments(0, 5) = "Brian Report 2"
marrInstruments(0, 6) = "Brian Report 2"
marrInstruments(0, 7) = "Brian Report 3"
marrInstruments(0, 8) = "Brian Report 3"
marrInstruments(0, 9) = "Brian Report 4"
marrInstruments(0, 10) = "Brian Report 4"

marrInstruments(1, 0) = "Example Type 1"
marrInstruments(1, 1) = "Example Type 2"
marrInstruments(1, 2) = "Example Type 3"
marrInstruments(1, 3) = "New Example Type 1"
marrInstruments(1, 4) = "New Example Type 2"
marrInstruments(1, 5) = "New Example Type 3"
marrInstruments(1, 6) = "New Example Type 4"
marrInstruments(1, 7) = "Zero Example Type 1"
marrInstruments(1, 8) = "Zero Example Type 2"
marrInstruments(1, 9) = "Zero Negate Example Type 1"
marrInstruments(1, 10) = "Zero Negate Example Type 2"

marrInstruments(8, 0) = 0
marrInstruments(8, 1) = 0
marrInstruments(8, 2) = 300000
marrInstruments(8, 3) = 100000
marrInstruments(8, 4) = 0
marrInstruments(8, 5) = -150000
marrInstruments(8, 6) = 100
marrInstruments(8, 7) = 0
marrInstruments(8, 8) = 0
marrInstruments(8, 9) = 100
marrInstruments(8, 10) = -100


Above is the new array.

Any help would be greatly appreciated.

Thanks

Brian

[Bob Phillips]

Try this



Sub Test()
Dim marrInstruments As Variant
Dim repOK As Boolean
Dim prevReport As String
Dim totalReport As Double
Dim lastRow As Long
Dim toRow As Long
Dim nextRow As Long
Dim i As Long, ii As Long

ReDim marrInstruments(0 To 8, 0 To 10)

marrInstruments(0, 0) = "Brian Report 1"
marrInstruments(0, 1) = "Brian Report 1"
marrInstruments(0, 2) = "Brian Report 1"
marrInstruments(0, 3) = "Brian Report 2"
marrInstruments(0, 4) = "Brian Report 2"
marrInstruments(0, 5) = "Brian Report 2"
marrInstruments(0, 6) = "Brian Report 2"
marrInstruments(0, 7) = "Brian Report 3"
marrInstruments(0, 8) = "Brian Report 3"
marrInstruments(0, 9) = "Brian Report 4"
marrInstruments(0, 10) = "Brian Report 4"

marrInstruments(1, 0) = "Example Type 1"
marrInstruments(1, 1) = "Example Type 2"
marrInstruments(1, 2) = "Example Type 3"
marrInstruments(1, 3) = "New Example Type 1"
marrInstruments(1, 4) = "New Example Type 2"
marrInstruments(1, 5) = "New Example Type 3"
marrInstruments(1, 6) = "New Example Type 4"
marrInstruments(1, 7) = "Zero Example Type 1"
marrInstruments(1, 8) = "Zero Example Type 2"
marrInstruments(1, 9) = "Zero Negate Example Type 1"
marrInstruments(1, 10) = "Zero Negate Example Type 2"

marrInstruments(8, 0) = 0
marrInstruments(8, 1) = 0
marrInstruments(8, 2) = 300000
marrInstruments(8, 3) = 100000
marrInstruments(8, 4) = 0
marrInstruments(8, 5) = -150000
marrInstruments(8, 6) = 100
marrInstruments(8, 7) = 0
marrInstruments(8, 8) = 0
marrInstruments(8, 9) = 100
marrInstruments(8, 10) = -100

For i = LBound(marrInstruments, 2) To UBound(marrInstruments, 2)

If marrInstruments(0, i) <> prevReport Then

prevReport = marrInstruments(0, i)
nextRow = nextRow + 1
With Cells(nextRow, "A")

.Value = prevReport
.Font.Bold = True
End With

nextRow = nextRow + 2
ii = i
totalReport = 0
repOK = True
Do

If ii <= UBound(marrInstruments, 2) Then

If marrInstruments(0, ii) <> prevReport Then

repOK = False
End If
Else

repOK = False
End If

If repOK Then

Cells(nextRow, "A") = marrInstruments(1, ii)
Cells(nextRow, "B") = marrInstruments(8, ii)
totalReport = totalReport + marrInstruments(8, ii)
ii = ii + 1
nextRow = nextRow + 1
End If
Loop Until Not repOK

nextRow = nextRow + 1
With Cells(nextRow, "A")

.Value = prevReport & " Total"
.Font.Bold = True
End With
Cells(nextRow, "B").Value = totalReport

i = ii - 1
nextRow = nextRow + 1
End If
Next i

lastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = lastRow To 2 Step -1

If Cells(i, "A").Value Like "* Total" Then

toRow = i
i = i - 2
Do While Cells(i, "A").Value <> ""

If Cells(i, "B").Value <> 0 Then toRow = 0
i = i - 1
Loop
ElseIf toRow <> 0 Then

If Cells(i, "A").Value = Left$(Cells(toRow, "A").Value, Len(Cells(toRow, "A").Value) - 6) Then

Rows(i).Resize(toRow - i + 2).Delete
End If
End If
Next i

Columns("A:B").AutoFit
End Sub

[youngmcc]

Fantastic!

Thanks so much for your help.

[youngmcc]

Infact.......
Hold that note....

I have a problem when the last member of the array is zero.


marrInstruments(8, 9) = 0
marrInstruments(8, 10) = 0


I am getting an invalid procedure or call error message on the below line.

If Cells(i, "A").Value = Left$(Cells(toRow, "A").Value, Len(Cells(toRow, "A").Value) - 6) Then

It looks like its because its comparing blank row 24 against the last blank row 30.

Any suggestions?

Thanks again

[youngmcc]

Managed to solve it.

Added the following

i = i - 1

after


.Rows(i).Resize(lngToRow - i + 2).Delete


Thanks again for your help