Range into Array and Array Summary into Range

[u473]

[1] Data Source Range : A2 to Header Row Column containing "Total
Cost" in Sheet("L2")
to be loaded in SourceArray
A B C ...
1. Code Month 1 Month 2 Month x Total Cost ...Other Data
2. A 2 4 3
3. B 7 1 4
4. A 5 2 8
5. C 9 6 0
6. B 1 4 2
7. A 2 5 5


[2] SourceArray is Summed in SumArray
The number of Codes is known and limited to 3
Code Month 1 Month 2 Month x Total Cost
(0) (1) (2) (3)
(0) A 9 11 16
(1) B 8 5 6
(2) C 9 6 0

[3] SumArray is written in Sheet("L1") starting in A10

.................................................
I inspired myself from a previous posting titled "Range into Array and
Array into Range"
but I fumbled in trying to :
1. Debug.print the array for testing purpose
2. Summarize the SourceArray into the SumArray
3. Writing the array back in a range
Help appreciated
.................................................
Sub SumArray()
Dim TopCol As Long 'Rightmost Column #
Dim Col As String ' Rightmost Column Letter
Dim HeadersRng As Range 'Headers Row
Dim SourceArray As Variant ' Array to receive Data Source Range
Dim SumArray As Variant ' Array summarizing SourceArray
Dim BotRow As Long
'Find Column in Row 1 containing word "Total Cost"
Worksheets("L2").Activate
Set HeadersRng = Range("A1", Cells(1, Columns.Count).End(xlToLeft))
TopCol = (HeadersRng.Find(What:="Total Cost", LookAt:=xlWhole).Column)
- 1
BotRow = (Cells(65536, 1).End(xlUp).Row) - 1
Col = Left(Cells(1, TopCol).Address(0, 0), 1 - (TopCol > 26))
'Ok, the above worked fine. Now loading Data Source Range into
SourceArray
With Sheets("L2")
SourceArray = Range("A2:" & Col & BotRow).Value
End With
'Test if Array is properly loaded with Debug.print
'Debug.Print failed. inapropriate syntax
'.......................................
'Initialize SumArray Column "A". Number of Summary Rows is limited to
3
SumArray(1, 1) = "A" ' This syntax not accepted
SumArray(2, 1) = "B"
SumArray(3, 1) = "C"
' Summarize SourceArray into SumArray
For i = 1 To 3
For j = 1 To BotRow
If SumArray(i, 1).Value = SourceArray(j, 1).Value Then
For k = 2 To TopCol
SumArray(i, k).Value = SumArray(i, k).Value + SourceArray
(j, k)
Next
End If
Next
Next
'Write SumArray back in Sheets("L1") starting in Cell A10
Sheets("L1").Range("A10").Value = SumArray 'This syntax not accepted
End Sub

 

[Per Jessen]

Hi

Look at this:

Option Explicit
Option Base 1

Sub SumArray()
Dim TopCol As Long 'Rightmost Column #
Dim Col As String ' Rightmost Column Letter
Dim HeadersRng As Range 'Headers Row
Dim SourceArray() As Variant ' Array to receive Data Source Range
Dim SumArray As Variant ' Array summarizing SourceArray
Dim BotRow As Long
Dim i As Long
Dim j As Long
Dim k As Long
Dim r As Long
Dim c As Long
Dim aVal As String
Dim bVal As String
'Find Column in Row 1 containing word "Total Cost"
Worksheets("L2").Activate
Set HeadersRng = Range("A1", Cells(1, Columns.Count).End(xlToLeft))
TopCol = HeadersRng.Find(What:="Total Cost", LookAt:=xlWhole).Column - 1
BotRow = (Cells(65536, 1).End(xlUp).Row)
Col = Left(Cells(1, TopCol).Address(0, 0), 1 - (TopCol > 26))

With Sheets("L2")
SourceArray = Range("A2:" & Col & BotRow).Value
End With

' Add a watch from the Debug menu and inset a break point to stop and
'check the values in the array in the Watches window


'Initialize SumArray Column "A". Number of Summary Rows is limited to 3

ReDim SumArray(3, TopCol)
SumArray(1, 1) = "A"
SumArray(2, 1) = "B"
SumArray(3, 1) = "C"

' Summarize SourceArray into SumArray
For i = LBound(SumArray) To UBound(SumArray)
For j = 1 To BotRow - 1
aVal = SumArray(i, 1)

bVal = SourceArray(j, 1)
If aVal = bVal Then
For k = 2 To TopCol
SumArray(i, k) = SumArray(i, k) + SourceArray(j, k)
Next
End If
Next
Next

'Write SumArray back in Sheets("L1") starting in Cell A10
For r = LBound(SumArray) To UBound(SumArray)
For c = LBound(SumArray, 2) To UBound(SumArray, 2)
Sheets("L1").Range("A10").Offset(r - 1, c - 1).Value = SumArray(r,
c)
Next
Next
End Sub


To learn more about arrays look at this site:

http://www.anthony-vba.kefra.com/vba/vbabasic3.htm

Hopes this helps.

---
Per

[1] Data Source Range : A2 to Header Row Column containing "Total
Cost" in Sheet("L2")
to be loaded in SourceArray
A B C ...
1. Code Month 1 Month 2 Month x Total Cost ...Other Data
2. A 2 4 3
3. B 7 1 4
4. A 5 2 8
5. C 9 6 0
6. B 1 4 2
7. A 2 5 5


[2] SourceArray is Summed in SumArray
The number of Codes is known and limited to 3
Code Month 1 Month 2 Month x Total Cost
(0) (1) (2) (3)
(0) A 9 11 16
(1) B 8 5 6
(2) C 9 6 0

[3] SumArray is written in Sheet("L1") starting in A10

................................................
I inspired myself from a previous posting titled "Range into Array and
Array into Range"
but I fumbled in trying to :
1. Debug.print the array for testing purpose
2. Summarize the SourceArray into the SumArray
3. Writing the array back in a range
Help appreciated
................................................
Sub SumArray()
Dim TopCol As Long 'Rightmost Column #
Dim Col As String ' Rightmost Column Letter
Dim HeadersRng As Range 'Headers Row
Dim SourceArray As Variant ' Array to receive Data Source Range
Dim SumArray As Variant ' Array summarizing SourceArray
Dim BotRow As Long
'Find Column in Row 1 containing word "Total Cost"
Worksheets("L2").Activate
Set HeadersRng = Range("A1", Cells(1, Columns.Count).End(xlToLeft))
TopCol = (HeadersRng.Find(What:="Total Cost", LookAt:=xlWhole).Column)
- 1
BotRow = (Cells(65536, 1).End(xlUp).Row) - 1
Col = Left(Cells(1, TopCol).Address(0, 0), 1 - (TopCol > 26))
'Ok, the above worked fine. Now loading Data Source Range into
SourceArray
With Sheets("L2")
SourceArray = Range("A2:" & Col & BotRow).Value
End With
'Test if Array is properly loaded with Debug.print
'Debug.Print failed. inapropriate syntax
'.......................................
'Initialize SumArray Column "A". Number of Summary Rows is limited to
3
SumArray(1, 1) = "A" ' This syntax not accepted
SumArray(2, 1) = "B"
SumArray(3, 1) = "C"
' Summarize SourceArray into SumArray
For i = 1 To 3
For j = 1 To BotRow
If SumArray(i, 1).Value = SourceArray(j, 1).Value Then
For k = 2 To TopCol
SumArray(i, k).Value = SumArray(i, k).Value + SourceArray
(j, k)
Next
End If
Next
Next
'Write SumArray back in Sheets("L1") starting in Cell A10
Sheets("L1").Range("A10").Value = SumArray 'This syntax not accepted
End Sub

 

[u473]

I did appreciate reading your solution like a brilliant move in Chess.
Now, I could come up with some convoluted and unesthetic SUM code
to have a Row and Columns Totals for r and c.
I could do it from the range, but what is the expert way of doing it
from the Array ?
In addition, for testing purpose I was trying to use Debug.print to
check the wole array after the last next.
But I get weird results in the immediate window.
This is the Debug.Print statement I used, and the syntax may in
error..
Debug.Print LBound(SumArray, 1), UBound(SumArray, 1), LBound(SumArray,
2), UBound(SumArray, 2)
Thank you again,
J.P.

 

[Per Jessen]

Hi

Thanks for your reply.

Your debug statement works fine...

Sum are calculated and pasted to sheet L1


Option Explicit
Option Base 1

Sub SumArray()
Dim TopCol As Long 'Rightmost Column #
Dim Col As String ' Rightmost Column Letter
Dim HeadersRng As Range 'Headers Row
Dim SourceArray() As Variant ' Array to receive Data Source Range
Dim SumArray As Variant ' Array summarizing SourceArray
Dim BotRow As Long
Dim SumCol As Long
Dim i As Long
Dim j As Long
Dim k As Long
Dim r As Long
Dim c As Long
Dim aVal As String
Dim bVal As String
'Find Column in Row 1 containing word "Total Cost"
Worksheets("L2").Activate
Set HeadersRng = Range("A1", Cells(1, Columns.Count).End(xlToLeft))
TopCol = HeadersRng.Find(What:="Total Cost", LookAt:=xlWhole).Column - 1
BotRow = (Cells(65536, 1).End(xlUp).Row)
Col = Left(Cells(1, TopCol).Address(0, 0), 1 - (TopCol > 26))
SumCol = TopCol + 1

With Sheets("L2")
SourceArray = Range("A2:" & Col & BotRow).Value
End With

' Add a watch from the Debug menu and inset a break point to stop and
'check the values in the array in the Watches window


'Initialize SumArray Column "A". Number of Summary Rows is limited to 3

ReDim SumArray(4, SumCol)
SumArray(1, 1) = "A"
SumArray(2, 1) = "B"
SumArray(3, 1) = "C"
SumArray(4, 1) = "Sum"

' Summarize SourceArray into SumArray
For i = LBound(SumArray) To UBound(SumArray)
For j = 1 To BotRow - 1
aVal = SumArray(i, 1)
bVal = SourceArray(j, 1)
If aVal = bVal Then
For k = 2 To TopCol
SumArray(i, k) = SumArray(i, k) + SourceArray(j, k)
'row sum
SumArray(4, k) = SumArray(4, k) + SourceArray(j, k)
'Column sum
Select Case aVal
Case Is = "A"
SumArray(1, SumCol) = SumArray(1, SumCol) +
SourceArray(j, k)
Case Is = "B"
SumArray(2, SumCol) = SumArray(1, SumCol) +
SourceArray(j, k)
Case Is = "C"
SumArray(3, SumCol) = SumArray(1, SumCol) +
SourceArray(j, k)
End Select
Next
End If
Next
Next

'Write SumArray back in Sheets("L1") starting in Cell A10
For r = LBound(SumArray) To UBound(SumArray)
For c = LBound(SumArray, 2) To UBound(SumArray, 2)
Sheets("L1").Range("A10").Offset(r - 1, c - 1).Value = SumArray(r,
c)
Next
Next
Debug.Print LBound(SumArray, 1), UBound(SumArray, 1), LBound(SumArray, 2),
UBound(SumArray, 2)
End Sub

Regards,
Per

 

[u473]

Here we go again.
The bottom Row had the right results but the SumCol did not.
I modified the last For Next as follows :
For k = 2 To TopCol
SumArray(i, k) = SumArray(i, k) + SourceArray(j, k) 'row sum
SumArray(4, k) = SumArray(4, k) + SourceArray(j, k) 'Column sum
SumArray(i, SumCol) = SumArray(i, SumCol) + SourceArray(j, k)
'Total Row Sum
SumArray(4, SumCol) = SumArray(4, SumCol) + SourceArray(j, k)
'Grand Total Row Sum
Next
and now I have the perfect summary, from Range to Array and back.
This was a major achievement for me, but I thank you again because you
put me back
in the right track in the first place.
..
The Debug.Print was only for testing purpose. I never saw my expected
values in the Immediate Window.
Where does Debug.Print send its data ?

Have a good day.
J.P.