• Status: Solved
  • Priority: Low
  • Security: Public
  • Views: 74
  • Last Modified:

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
0
Flora
Asked:
Flora
  • 7
  • 6
1 Solution
 
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
Cloud Class® Course: Ruby Fundamentals

This course will introduce you to Ruby, as well as teach you about classes, methods, variables, data structures, loops, enumerable methods, and finishing touches.

 
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
 
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
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Cloud Class® Course: Certified Penetration Testing

This CPTE Certified Penetration Testing Engineer course covers everything you need to know about becoming a Certified Penetration Testing Engineer. Career Path: Professional roles include Ethical Hackers, Security Consultants, System Administrators, and Chief Security Officers.

  • 7
  • 6
Tackle projects and never again get stuck behind a technical roadblock.
Join Now