VBA Modification, Do i have to have too many seperate Subs for each of these cells?

I had this question after viewing Modification of VBA to use named range instead of offset.

Rgonzo1971 was very kind of helping me many times.  the code  in earlier post was great. now i tried to implement this into my worksheet. it seems like for every cell, i have created two procedures for two cell. please see attached file. but i think there have to be a easiler way to combine all of these into one Sub Procesure. i do not know how to do this. any help is appreciated. if it would not be simplified then it seems like i have to have 16 seperate procedures for each of the cells.

EEE.pngEE.xlsb
LVL 6
FloraAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

ShumsDistinguished Expert - 2017Commented:
Hi Flora,

Try below:
Sub CombinedResult()
Dim Ws As Worksheet, DataSh As Worksheet
Dim LRow As Long, RowIndex As Long, ColIndex As Long, LR As Long, LC As Long
Dim RngYear As Range, RngMonth As Range, SumRng As Range
Dim FinalResult As Variant
Set Ws = Worksheets("Main")
Set DataSh = Worksheets("Data")
LR = Ws.Range("A" & Rows.Count).End(xlUp).Row
LC = Ws.Cells(2, Columns.Count).End(xlToLeft).Column
LRow = DataSh.Range("A" & Rows.Count).End(xlUp).Row
Set RngYear = DataSh.Range("A2:A" & LRow)
Set RngMonth = DataSh.Range("B2:B" & LRow)
Set SumRng = DataSh.Range("D2:D" & LRow)
Application.ScreenUpdating = False
For RowIndex = 3 To LR
    For ColIndex = 2 To LC
        FinalResult = Application.WorksheetFunction.SumIfs(SumRng, RngMonth, Ws.Cells(RowIndex, "A").Value, RngYear, Ws.Cells(2, ColIndex).Value)
        Ws.Cells(RowIndex, ColIndex).Value = FinalResult
    Next ColIndex
Next RowIndex
Ws.Activate
Application.ScreenUpdating = True
End Sub

Open in new window

Flora_MultipleSums.xlsb
0
FloraAuthor Commented:
Thanks Shams. but your macro is not generating correct calculated result.

this is what your macro generates.
2017-11-21-16_42_11-Flora_MultipleSu.png
and
this is what should be the correct figures

crr.pngSolution-by-Shams.xlsb
0
FloraAuthor Commented:
Also, i want to use my named ranges, as previously was helped in the code by Rgonzo1971.  becuase my columns will be moving around and static column cannot work for me.

so i modified Rgonzo1971's code and made two macros attached below. for 2 of the cells.

for cell B3 below is the macro
Sub macro2011_Month_2()
'for 2011 month 2
Dim Main As Worksheet
intYearCol = Range("dataYear").Column
intMonthCol = Range("dataMonth").Column
intProductCol = Range("dataPRODUCT").Column
intAmountCol = Range("dataAMOUNT").Column
Set Main = Sheets("Main")
Set ShD = Sheets("Data")
For Each c In Range(ShD.Range("a2"), ShD.Range("a" & Rows.Count).End(xlUp))
    If ShD.Cells(c.Row, intYearCol).Value = (Main.Range("B2").Value2 * 1) And ShD.Cells(c.Row, intMonthCol).Value = (Main.Range("A3").Value2 * 1) _
            And ShD.Cells(c.Row, intMonthCol).Value <> 111 And _
            ShD.Cells(c.Row, intProductCol).Value Like "[5-7]*" Then
        mySum = mySum + ShD.Cells(c.Row, intAmountCol).Value
    End If
Next
Main.Range("B3") = mySum
End Sub

Open in new window


and for cell C3  below macro

Sub Macro2012_Month_2()
 ' for 2012 month 2
Dim Main As Worksheet
intYearCol = Range("dataYear").Column
intMonthCol = Range("dataMonth").Column
intProductCol = Range("dataPRODUCT").Column
intAmountCol = Range("dataAMOUNT").Column
Set Main = Sheets("Main")
Set ShD = Sheets("Data")
For Each c In Range(ShD.Range("a2"), ShD.Range("a" & Rows.Count).End(xlUp))
    If ShD.Cells(c.Row, intYearCol).Value = (Main.Range("C2").Value2 * 1) And ShD.Cells(c.Row, intMonthCol).Value = (Main.Range("A3").Value2 * 1) _
            And ShD.Cells(c.Row, intMonthCol).Value <> 111 And _
            ShD.Cells(c.Row, intProductCol).Value Like "[5-7]*" Then
        mySum = mySum + ShD.Cells(c.Row, intAmountCol).Value
    End If
Next
Main.Range("C3") = mySum
End Sub

Open in new window


so i have 14 more cell that means with the two above macros total 16 macros to generate the result. but there has to be an easy way.
0
Determine the Perfect Price for Your IT Services

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden with our free interactive tool and use it to determine the right price for your IT services. Download your free eBook now!

ShumsDistinguished Expert - 2017Commented:
Flora,

Your pivot is showing wrong figure, filter in Data Sheet and check
For 3rd Month for 2011, total should be 25,958.69 and not 91,857.21
I have created a new pivot, check in attached...
Flora_MultipleSums_v2.xlsb
0
ShumsDistinguished Expert - 2017Commented:
Anyway, if your columns will change obviously you gonna change in Named Range, this is what you can do in my macro as well, just change the column reference, you may get the same result.
0
FloraAuthor Commented:
Shums,

you are missing the PRODUCT filter in your pivot table.

if you use this macro for 2011 month 3  then you will get the correct result.

Sub macro2011_Month_2()
'for 2011 month 2
Dim Main As Worksheet
intYearCol = Range("dataYear").Column
intMonthCol = Range("dataMonth").Column
intProductCol = Range("dataPRODUCT").Column
intAmountCol = Range("dataAMOUNT").Column
Set Main = Sheets("Main")
Set ShD = Sheets("Data")
For Each c In Range(ShD.Range("a2"), ShD.Range("a" & Rows.Count).End(xlUp))
    If ShD.Cells(c.Row, intYearCol).Value = (Main.Range("B2").Value2 * 1) And ShD.Cells(c.Row, intMonthCol).Value = 3_
            And ShD.Cells(c.Row, intMonthCol).Value <> 111 And _
            ShD.Cells(c.Row, intProductCol).Value Like "[5-7]*" Then
        mySum = mySum + ShD.Cells(c.Row, intAmountCol).Value
    End If
Next
Main.Range("B3") = mySum
End Sub

Open in new window

0
ShumsDistinguished Expert - 2017Commented:
Flora,

But you are not using any Product details for your Main Sheet :) :P
0
FloraAuthor Commented:
i am using it.

this code line  helped by Rgonzo1971's filters out anything that starts other than 5, 6 ,7 in product ID

ShD.Cells(c.Row, intProductCol).Value Like "[5-7]*" Then
0
ShumsDistinguished Expert - 2017Commented:
Ok.

Let me include Products as well.
0
ShumsDistinguished Expert - 2017Commented:
Try below:
Sub CombinedResult()
Dim Ws As Worksheet, DataSh As Worksheet
Dim LRow As Long, RowIndex As Long, ColIndex As Long, LR As Long, LC As Long
Dim RngYear As Range, RngMonth As Range, ProdRng As Range, SumRng As Range
Dim ProdCrit1 As String, ProdCrit2 As String, ProdCrit3 As String
Dim FinalResult As Variant
Set Ws = Worksheets("Main")
Set DataSh = Worksheets("Data")
LR = Ws.Range("A" & Rows.Count).End(xlUp).Row
LC = Ws.Cells(2, Columns.Count).End(xlToLeft).Column
LRow = DataSh.Range("A" & Rows.Count).End(xlUp).Row
Set RngYear = DataSh.Range("A2:A" & LRow)
Set RngMonth = DataSh.Range("B2:B" & LRow)
Set ProdRng = DataSh.Range("C2:C" & LRow)
Set SumRng = DataSh.Range("D2:D" & LRow)
ProdCrit1 = "5*"
ProdCrit2 = "6*"
ProdCrit3 = "7*"
Application.ScreenUpdating = False
For RowIndex = 3 To LR
    For ColIndex = 2 To LC
        FinalResult = Application.WorksheetFunction.SumIfs(SumRng, ProdRng, ProdCrit1, RngMonth, Ws.Cells(RowIndex, "A").Value, RngYear, Ws.Cells(2, ColIndex).Value) + Application.WorksheetFunction.SumIfs(SumRng, ProdRng, ProdCrit2, RngMonth, Ws.Cells(RowIndex, "A").Value, RngYear, Ws.Cells(2, ColIndex).Value) + Application.WorksheetFunction.SumIfs(SumRng, ProdRng, ProdCrit3, RngMonth, Ws.Cells(RowIndex, "A").Value, RngYear, Ws.Cells(2, ColIndex).Value)
        Ws.Cells(RowIndex, ColIndex).Value = FinalResult
    Next ColIndex
Next RowIndex
Ws.Activate
Application.ScreenUpdating = True
End Sub

Open in new window

Flora_MultipleSums_v3.xlsb
0
Rgonzo1971Commented:
Hi,

pls try
Sub macroAll()

Dim Main As Worksheet
intYearCol = Range("dataYear").Column
intMonthCol = Range("dataMonth").Column
intProductCol = Range("dataPRODUCT").Column
intAmountCol = Range("dataAMOUNT").Column
Set Main = Sheets("Main")
Set ShD = Sheets("Data")

For Each cl In Range(Main.Range("B3"), Main.Range("C10"))
mySum = 0
    For Each c In Range(ShD.Range("a2"), ShD.Range("a" & Rows.Count).End(xlUp))
        If ShD.Cells(c.Row, intYearCol).Value = (Main.Cells(2, cl.Column).Value2 * 1) And ShD.Cells(c.Row, intMonthCol).Value = (Main.Range("A" & cl.Row).Value2 * 1) _
                And ShD.Cells(c.Row, intMonthCol).Value <> 111 And _
                ShD.Cells(c.Row, intProductCol).Value Like "[5-7]*" Then
            mySum = mySum + ShD.Cells(c.Row, intAmountCol).Value
        End If
    Next
cl.Value = mySum
Next
End Sub

Open in new window

Regards
1

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
FloraAuthor Commented:
WOW!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!


i could not imagine this could be done with this short code.  Rgonzo1971  You are amazing!
0
FloraAuthor Commented:
Thanks Shams.  but Rgonzo's solution is more robust and works fine for me.  i thank you for your wiliness for help as well.
0
FloraAuthor Commented:
now i have put until k20 and work just like a charm.

thanks again Rgonzo1971
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Office

From novice to tech pro — start learning today.