Solved: SUMPRODUCT - Multiple Cells (Looking for VBA Method)

[Hoopsah]

Hi

I have a spreadsheet that has multiple calculations, I am using SUMPRODUCT for them but I have over 1000 cells and obviously using a formula in every cell is a tad horrible.

I have attached a copy.

This is the start of a project and I am starting to get bogged down with formula, so looking for a way to do the calculations via VBA, hopefully I can then utilise it across the other sheets in this project.

As always, any help gratefully received,

Cheers

[Bob Phillips]

Sub AddFormulae()
Const FORMULA_DATES As String = _
"=SUMPRODUCT(--(Database!$A$2:$A$<dbrows><=<thiscol>$3),--(Database!$A$2:$A$<dbrows>><prevcol>$3),--(Database!$E$2:$E$<dbrows>=$A4))"
Dim dblastrow As Long
Dim firstset As Long
Dim prevcol As String
Dim thiscol As String
Dim lastrow As Long
Dim lastcol As Long
Dim nextcol As Long
Dim i As Long

With Worksheets("Database")

dblastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With

With Worksheets("Work Type Volume Summary")

firstset = Application.Match("Total", .Rows(3), 0) - 2
lastrow = .Range("B4").End(xlDown).Row - 1
lastcol = .Cells(3, Columns.Count).End(xlToLeft).Column
.Range("B4").Resize(lastrow - 3, 4).Formula = Replace(Replace(Replace(FORMULA_DATES, _
"<thiscol>", "B"), _
"<prevcol>", "A"), _
"<dbrows>", dblastrow)
.Cells(4, firstset + 2).Resize(lastrow - 3, 1).FormulaR1C1 = "=SUM(RC2:RC[-1])"
nextcol = 6
For i = 7 To lastcol - 1

nextcol = i + Application.Match("Total", .Cells(3, nextcol + 1).Resize(1, lastcol - nextcol + 1), 0) - 1
thiscol = Split(.Cells(1, i).Address(, False), "$")(0)
prevcol = Split(.Cells(1, i - 2).Address(, False), "$")(0)
.Cells(4, i).Resize(lastrow - 3).Formula = Replace(Replace(Replace(FORMULA_DATES, _
"<thiscol>", thiscol), _
"<prevcol>", prevcol), _
"<dbrows>", dblastrow)
.Range("B4").Copy .Cells(4, i + 1).Resize(lastrow - 3, nextcol - i - 1)
.Cells(4, nextcol).Resize(lastrow - 3, 1).FormulaR1C1 = "=SUM(RC" & i & ":RC[-1])"
With .Cells(4, i).Resize(lastrow - 3, nextcol - i + 1)

.Value = .Value
End With

i = nextcol
Next i

With .Range("B4").Resize(lastrow - 3, firstset)

.Value = .Value
End With

With .Cells(lastrow + 1, 2).Resize(, lastcol - 1)

.Formula = "=SUM(B4:B" & lastrow & " )"
.Value = .Value
End With
End With
End Sub

[Hoopsah]

WOW!

That is phenomenal Bob, I know I say this every time, but seriously, I don't think I will ever bore seeing how easy you make these problems look.

I have quite a big project on at the moment and I think I will be able to adapt this to many of the sheets I have, so I will mark this as solved as this part works perfectly.

Hats Off Bob!

[Bob Phillips]

Easy? The different number of weeks per month and the totals took some managing. I really worked on that. :)

[snb]

I thought the pivottable had been designed for this purpose.

[Hoopsah]

Never thought of a Pivot for this, the only thing that bothers me as I have to submit it with the "Week Ending dates" and to get this information into the pivot I find I am using the SUMPRODUCT in every cell in the database again, which is what I was trying to get away from in the first place.


Bob,

I have tried to amend your program to update the next sheet but I'm afraid I am failing miserably.

Can I ask a favour: Can you amend your work to update the Work Priority Summary page also, and hopefully when I see the changes I will be able to amend it to suit my other sheets.

Thanks for your help,

Gerry

[snb]

You can omit all sumproduct formulae using a pivottable.

[Hoopsah]

Sorry snb,

What I meant was, in order to get the data to go into the pivot, I would have to run a SUMPRODUCT in the database to get it into Before one date but after the next in weekly chunks.

You had done your pivot with week number which doesn't specify the actual date.

[snb]

Don't think so....

[Hoopsah]

Ahh! That is really good, I don't really like Pivots but this one does do what I asked. OK, I will try and run a few more for the other sheets I have and see if I can get it all to work,

Thanks for your help snb

[snb]

To prevent the 'slowing' down of this workbook you can use a simple macro to fill the columns 'week' & 'month' in the worksheet 'database' instead of the formulae it contains in my example.