ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Range into Array and Array Summary into Range (https://www.excelbanter.com/excel-programming/424525-range-into-array-array-summary-into-range.html)

u473

Range into Array and Array Summary into Range
 
[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

Range into Array and Array Summary into Range
 
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

"u473" skrev i meddelelsen
...
[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

Range into Array and Array Summary into Range
 
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

Range into Array and Array Summary into Range
 
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" skrev i meddelelsen
...
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.



u473

Range into Array and Array Summary into Range
 
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.


All times are GMT +1. The time now is 01:22 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com