Solved: Arrays with Arrays

[Philcjr]

Need some help here...

I have attached a sample workbook to help with my request.

I have a huge file with all my credit card charges over the past 5 years (over 4000 rows) and I am looking to speed up some calculations. Currently, I am using Evaluate(SumProduct formula)... while this works, it is rather slow.

So...
1) I need help summing the "Charge Amounts" (Col C) by "Code" (Col A) by "Billing Cycle" (Col B). I have the unique "Codes" and "Billing Cycles" in an Array and have combined them both into one array.

2) Then I need to write the values back to the worksheet... Columns E:L

Thanks for ANY HELP... any questions please let me know

Phil

[Mis_Sailesh]

Hi
Please see if this works, I have solved the case by using Array formula
Kindly revert....


Attachment 3171

[Philcjr]

Sailesh,

Thanks, but I was trying to do this without using a Pivot Table... While I think this approach could work, I am interested to learn how this also can be done via arrays

Phil

[Mis_Sailesh]

Hi
Please ignore/delete the Pivot sheet,
I have used Array Formulas in the formatted cells of the sheet named "Original Data" as :-

"=SUM(($A$2:$A$35=F$1)*($B$2:$B$35=$E2)*($C$2:$C$35))"

Please see cells (formula) in cells through F2 to L8...

Kindly revert ....

[Bob Phillips]

Array formulae are going to be just as slow as SUMPRODUCT, so if you want it speeded up you will either have to pivot it, use helper columns or VBA.

[Philcjr]

Bob,
How disapointing it is to hear that Evaluate(Sumproduct) is around the same speed as Array Formulae.
Phil

[Philcjr]

If anyone wishes to help with the Arrays, I will test and post my resluts...

[Bob Phillips]

You've already been given that. Are you asking for it in VBA?

[Philcjr]

Bob,
Yes, in VBA... sorry for not being clear

[Bob Phillips]

Are you wanting to populate the table with array formulae, or just populate with the result using Evaluate?

[mdmackillop]

Why not copy/Paste special historical data and apply the Sumproduct or whatever to a much more restricted volume of data.
eg
[VBA]
Set c = Columns(2).Find("03/2010").Offset(, -1)
Set data = Range(c, c.End(xlDown)).Resize(, 3)

[/VBA]

[Philcjr]

Bob,

I would want to just write out the value.

Would it be faster to use autofilter and then sum the visible cells vs Evaluate?

THANKS for your help,
Phil

[Bob Phillips]

That would be fast Phil in a single instance, but if you are trying to create a table of results, it would probably be quicker to run the formulae. I would tend to do it by putting the formula in the cells, then copy-paste values. But it will still be slow if it is slow now.

[ZVI]

Hi Phil,

What about macro recording of the pivot table creation in temporary sheet with "Billing cycle" as the rows, "Code" as the fields and "Amount" as the result?

After setting up of the rows & fields sorting just copy as values the pivot table range and delete the temporary sheet. Close macro recording, add ScreanUpdating =False/True and tweak up the code to suit.

Vladimir

[SamT]

This example takes .39 seconds to crawl the data table and another 5 seconds to build the summary table. I don't know if that's as fast as you are getting or not.

BTW, I count clearing the summing record as part of the summary table time. That's probably half the time.

4590 entries/lines

[Philcjr]

All,
Thanks for your replies... I am leaving for the day, I will address each one later tonight

Sam,
You file does not "sum" the code values for the billing cycle.... the object was to have one row per Billing Cyce and the sum of charges per code.

Anyway, Happy Easter everyone

[SamT]

Sam,
You file does not "sum" the code values for the billing cycle.... the object was to have one row per Billing Cyce and the sum of charges per code.

It does exactly that on my computor. The only thing my example doesn't do is put the year breaks in the summary table.

Edit: Looking at your sample of dummy data it is easy to assume that you will actually have more than 6 months (repeated 300 times) worth. Since your sample data was sorted on the Date and then copied down several times, one can also assume that the real data will be sorted on the date. If you first sort all the dummy data in my sample data on the date, you will get 6 lines in the summary table in about 0.4 seconds. My program assumes that you are actually going to have at least 60 months worth of data.

Try it with this example, where I have done some more of your work and Extended the timeline to about 60 months. It takes all of .8 seconds. If you want to unsort the Code Data "BABY" et al, feel free.
[/End Edit]

You can use the Row Crawling code in my example:
[vba]
EndCycle = StartCycle
Do Until Cells(EndCycle, B) <> Cells(EndCycle, B).Offset(1, 0)
EndCycle = EndCycle + 1
Loop
[/vba]
to figure out how to insert year breaks in the summary table yourself.

BTW, how long did your original code take to perform the task?

[mdmackillop]

Here is a Filter method using Sam's data.
Interestingly, it runs in 0.5 secs on my "old" 2003 Excel PC and 3.1 secs on "new" Excel 2007 one.

[Philcjr]

Malcolm - I like your approach and your file took about .5 sec on my work laptop, XL2003.

I will revise my code and reply back with my results.

THANKS all for your help,
Phil

[Philcjr]

Malcom,
I revised your code to fit my needs... timing went from around 12sec to 7sec. THANKS. This is huge considering that there are 23 Codes and 71 BillingCycles which means that there are 1,633 times that AdvancedFilter needs to perform action on.

Here is the final code, which works... I would be interested to learn if there are any other areas in which I could further improve speed or better write code.

[vba]
Function FindBillCycleRowTEST()
'To find the Billing Cycle Row on Sheet "Roll-Up", so that "zeros" do not populate future months
Dim lMTH As Long, lDay As Long, lYR As Long, sDate As String
Let lMTH = Month(Date): Let lDay = Day(Date): Let lYR = Year(Date)
If lMTH = 1 And lDay <= 6 Then
lMTH = 12
lYR = lYR - 1
ElseIf lDay <= 6 Then
lMTH = lMTH - 1
End If
sDate = Format(lMTH & "/01/" & lYR, "mmm yyyy")
Call Module1.SumChargesTEST(sDate)
End Function

Sub SumChargesTEST(ByVal sDate As String)
Dim rCode As Range, rBillingCycle As Range, rCriteria As Range
Dim LastCol As Long, BalCol As Long, TransCol As Long, BillCycleRow As Long
Dim FOE As Long, GRO As Long, TFOOD As Long, PAY As Long, WEDD As Long
Dim C As Long, BC As Long, X As Long, R As Long
Dim ChargeSum As Double, Charged As Double, Payment As Double

Application.DisplayStatusBar = False

Dim Start As Double, Finish As Double
Start = Timer

Call Tools.NamedRanges
Call Tools.SettingsOff

With ThisWorkbook.Worksheets("Roll-Up")
With .Rows(1)
Let BalCol = .Find("Balance", , LookIn:=xlValues, LookAt:=xlWhole).Column
Let TransCol = .Find("Trans", , LookIn:=xlValues, LookAt:=xlWhole).Column
Let FOE = .Find("FOE", , LookIn:=xlValues, LookAt:=xlWhole).Column
Let GRO = .Find("GRO", , LookIn:=xlValues, LookAt:=xlWhole).Column
Let TFOOD = .Find("FOE-GRO", , LookIn:=xlValues, LookAt:=xlWhole).Column
Let PAY = .Find("PAY", , LookIn:=xlValues, LookAt:=xlWhole).Column
Let WEDD = .Find("WEDD", , LookIn:=xlValues, LookAt:=xlWhole).Column
End With
' Locate the row for current Billing Cycle
Let BillCycleRow = .Range("A:A").Find(sDate, LookIn:=xlValues, LookAt:=xlWhole).Row
' Define the range for the Codes
Set rCode = .Range("B1:X1")

' Define the range for the Billing Cycles
Set rBillingCycle = .Range("A2:A" & BillCycleRow)

' Clear the range on the "Roll-Up" sheet for new values
.Range("B3:AB" & BillCycleRow).ClearContents
End With

'Create Named Ranges
Names.Add Name:="CondFormat", RefersToR1C1:="='Roll-Up'!R5C2:R" & BillCycleRow & "C" & TFOOD
Names.Add Name:="SummedCharges", RefersToR1C1:="='Roll-Up'!R2C2:R" & BillCycleRow & "C" & WEDD

'Define the range for the "Criteria" that is used in the AdvancedFilter
Set rCriteria = ThisWorkbook.Worksheets("Charges").Range("AY1:AZ2")
Let rCriteria(1) = "Code"
Let rCriteria(2) = "Billing Cycle"

'Start looping through the data and filter on the Codes & Billing Cycle
With ThisWorkbook.Worksheets("Charges")
.Range("AZ2").NumberFormat = "@"
For C = 1 To 23 'Number of Codes - Columns
For R = 1 To BillCycleRow - 1 'Number of Billing Cycles - Rows

Let rCriteria(3) = rCode(C)
Let rCriteria(4) = Format(rBillingCycle(R), "YYYY/MM")

' Test to see if there is a blank row between years (Billing Cycle)
If rCriteria(4) = "" Then GoTo XX
.Range("Charges").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=rCriteria, _
CopyToRange:=Range("BA1:BF1"), _
Unique:=False

'Sum the "Amounts" to get total value for the Code & Billing Cycle
ThisWorkbook.Worksheets("Roll-Up").Range("A1").Offset(R, C) = Application.Sum(Columns(58))
.Range("BA:BF").ClearContents
XX:
Next R
Next C

rCriteria.Clear
.Range("BA:BF").Clear
End With
With ThisWorkbook.Worksheets("Roll-Up")
.Select
For R = 3 To BillCycleRow
' Test to see if there is a blank row between years (Billing Cycle)
If IsEmpty(Range("A" & R)) Then GoTo XXX

Let ChargeSum = 0
Let ChargeSum = Application.WorksheetFunction.Sum(.Range(Cells(R, 2), Cells(R, BalCol - 1)))
Let Charged = ChargeSum + Abs(.Cells(R, PAY).Value)
Let ChargeSum = ChargeSum + .Range("AD" & R).Value

' Calculate the "Balance" Column
If IsEmpty(.Cells(R - 1, BalCol)) Then
.Cells(R, BalCol).Value = Format(ChargeSum + .Cells(R - 2, BalCol).Value, "$#,##0.00;[Red]$#,##0.00")
Else
.Cells(R, BalCol).Value = Format(ChargeSum + .Cells(R - 1, BalCol).Value, "$#,##0.00;[Red]$#,##0.00")
End If

' Calculate the "Charged" Column
.Cells(R, BalCol + 1).Value = Format(Charged, "$#,##0.00;[Red]$#,##0.00")
' Calculate the "Total FOE & GRO" Column
.Cells(R, TFOOD).Value = .Cells(R, FOE).Value + .Cells(R, GRO).Value
' Calculate the "Incured Balance" Column
Let Payment = .Cells(R, PAY).Value
.Cells(R, TFOOD + 1).Value = Charged + Payment + .Cells(R, TransCol).Value
XXX:
Next R
End With

Finish = Timer
MsgBox Finish - Start

Call Tools.PivotTableRefresh
Call Tools.SettingsOn
Application.DisplayStatusBar = True

Range("A1").Select

'Clear Variables
Set rCode = Nothing: Set rBillingCycle = Nothing: Set rCriteria = Nothing
Let LastCol = 0: Let BalCol = 0: Let TransCol = 0: Let FOE = 0: Let BillCycleRow = 0
Let GRO = 0: Let TFOOD = 0: Let PAY = 0: Let WEDD = 0: Let C = 0:
Let X = 0: Let R = 0: Let ChargeSum = 0: Let BC = 0: Let Charged = 0: Let Payment = 0
CreateObject("WScript.Shell").Popup "Completed!", 1, "Sum Charges", 0 + 64
End Sub

[/vba]