View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Per Jessen Per Jessen is offline
external usenet poster
 
Posts: 1,533
Default 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