PDA

View Full Version : Solved: SUMPRODUCT in VBA Code



Philcjr
03-17-2008, 06:47 AM
All,
I need some help here, my "SUMPRODUCT" is not working and I just can not figure out what is wrong :dunno

The file I am working in is a personal file with my finance... hence why a file is not attached.

So here goes...


Sub SumCharges()

Dim X As Long, C As Long

Dim ws As Worksheet: Set ws = Application.Worksheets("Charges")
Dim LastRow As Long: Let LastRow = ws.Range("A65536").End(xlUp).Row

Dim ws1 As Worksheet: Set ws1 = Application.Worksheets("Roll-Up")
Dim LastRow1 As Long: Let LastRow1 = ws1.Range("A65536").End(xlUp).Row
Dim LastCol As Long: Let LastCol = ws1.Range("A" & LastRow1).End(xlToRight).Column

With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

'Define the ranges used in SUMPRODUCT
Dim rDate As Range: Set rDate = ws.Range("C2:C" & LastRow)
Dim rCode As Range: Set rCode = ws.Range("A2:A" & LastRow)
Dim rAmount As Range: Set rAmount = ws.Range("F2:F" & LastRow)

For C = 2 To LastCol 'Used for populating all Columns
For X = 5 To LastRow1 - 5 'Used for populating all Rows
If Cells(X, 1).Value = "" Then GoTo ZZ:
Cells(X, C).Value = Application.WorksheetFunction.SumProduct _
((rCode = Cells(1, C).Value) * (rDate = "2005/02") * (rAmount))
ZZ:
Next X
Next C

With Application
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End Sub

Bob Phillips
03-17-2008, 08:30 AM
SUMPRODUCT is not expoosed to Worksheetfunction, you have to evaluate itt



sFormula = "SumProduct(--(A2:A" & LastRow & "=" & Cells(1, C).Value & _
"),--(C2:C" & LastRow & "=""2005/02""),(F2:F" & LastRow & ")"
Cells(X, C).Value = ActiveSheet.Evaluate(sFormula)

Philcjr
03-18-2008, 06:26 AM
Bob,
As usual you save the day. THANKS for your help.

Here is the final code, if anyone wishes to comment or revise the code... feel free... as of now it takes about 10 seconds to complete:


Sub SumCharges()

Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Charges")
Dim LastRow As Long: Let LastRow = ws.Range("A65536").End(xlUp).Row
Dim rDate As Range: Set rDate = ws.Range("C2:C" & LastRow)
Dim rCode As Range: Set rCode = ws.Range("A2:A" & LastRow)
Dim rAmount As Range: Set rAmount = ws.Range("F2:F" & LastRow)

Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Worksheets("Roll-Up")
Dim LastRow1 As Long: Let LastRow1 = ws1.Range("A65536").End(xlUp).Row
Dim LastCol As Long: Let LastCol = ws1.Range("A" & LastRow1).End(xlToRight).Column

Call Settings.SettingsOff

Dim R As Long, C As Long 'Used for Rows and Columns
Dim sFormula As String, sYear As String, sMonth As String
For C = 2 To LastCol 'Used for populating Columns
Application.StatusBar = Format(((C - 1) / LastCol) * 100, "0.0") & "% Complete..."
For R = 2 To LastRow1 - 5 'Used for populating Rows
If Cells(R, 1).Value = "" Then GoTo ZZ:

sYear = ws1.Evaluate("Year(A" & R & ")") & "/"
sMonth = Format(ws1.Cells(R, 1), "mm")
sFormula = "SumProduct((Code" & "=""" & Cells(1, C).Value & """)*(Date=""" & sYear & sMonth & """)*(Amount))"

Cells(R, C).Value = ws1.Evaluate(sFormula)
ZZ:
Next R
Next C
Call Settings.SettingsOn
End Sub