Concurrent SUM & SUMPRODUCT calculation in a dynamic range.

Lomic6

New member
Joined
Jul 21, 2011
Messages
19
Reaction score
0
Points
0
Hi All,

I just joined XLguru and this is my first post.

I have one issue for which i would need your help/feedback.

This is my issue:
I have a master data in "Sheet1" containing info about Month, Region, Activity, Nbr of cartons and cycle time (in decimal),...


MonthRegionActivityCTCarton2GCIR23271GCIR24291SAIR11102SAIR23282SAIR24231SAIR24232SAMFE3732SAMFE371


With a VBA program, excel copies the data in "Sheet2" and proceed to a sorting + inserting an empty row to separate the data per month, region, activity, as follow:

Code as below:

Code:
Sub WorkSheetSort1()
Dim Rw As Range
Dim Column As Long
 
Application.ScreenUpdating = False
 
Worksheets("Master").Select
ActiveCell.SpecialCells(xlLastCell).Select
Range(Selection, cells(1)).Select
 
For Each Rw In Selection.Rows
Column = Rw.Row
If Rw.cells(1, 1).Value <> " " Then
Rw.Copy Destination:=Worksheets("Region").cells(Column, 1).EntireRow
End If
 
Next Rw
 
Worksheets("Master").Select
Range("A1").Select
Worksheets("Region").Select
Range("A:U").Sort Key1:=Range("C2"), Order1:=xlAscending, _
Key2:=Range("B2"), Order2:=xlYes, Header:=xlYes, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
 
Call myMonth
Call InsertRows1
Call mySubT1
Call myAutoFit
 
End Sub


And i obtain the following result:

MonthRegionActivityCTCarton1GCIR24.229?292GCIR23.127?271SAIR11101SAIR24.223?332SAIR23.1282SAIR24.223?512SAMFE3732SAMFE371?4

The above data are in the following column:
Month = Column B
Region = Column C
Activity = Column D
CT = Column J
Carton = Column M

As you can see the above data, after sorting, looks like blocks of data.

To calculate the SUM of my nbr of cartons and to insert the result in the empty row, I am using the following code:

Code:
Sub mySubT1()
 
'Do Subtotal SUM
For Each aArea In ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants).Areas
Rows(aArea.Row + aArea.Rows.Count).Font.ColorIndex = 5
Rows(aArea.Row + aArea.Rows.Count).Font.Bold = True
    cells(aArea.Row + aArea.Rows.Count, 13).Formula = "=SUM(" & Range(cells(aArea.Row, 13), cells(aArea.Row + aArea.Rows.Count - 1, 13)).Address & ")"
    cells(aArea.Row + aArea.Rows.Count, 14).Formula = "=SUM(" & Range(cells(aArea.Row, 14), cells(aArea.Row + aArea.Rows.Count - 1, 14)).Address & ")"
    cells(aArea.Row + aArea.Rows.Count, 19).Formula = "=SUM(" & Range(cells(aArea.Row, 19), cells(aArea.Row + aArea.Rows.Count - 1, 19)).Address & ")"
    cells(aArea.Row + aArea.Rows.Count, 20).Formula = "=SUM(" & Range(cells(aArea.Row, 20), cells(aArea.Row + aArea.Rows.Count - 1, 20)).Address & ")"
 
Next aArea
End Sub


Now I would need to calculate for each block of data the SumProduct of the CT(col10) versus the Carton(col13): =SUMPRODUCT(CT(col10)*Carton(col13))/TotCarton(col13)
And insert the result in the empty row in the corresponding column (see "?")

This knowing that the above data is dynamic, so i cannot determine a fix range like ("C2:C7"), because the lengh of those ranges will change every month.

Please let me know if you can help me coding this SUMPRODUCT portion for my case.

Thanks in advance for your help,
Lomic6
 
Hi there, and welcome to the forum!

Is there any way that you can upload a sample workbook with data in it? I'm not sure that I'm quite visualizing the output as it is in the workbook... You refer to columns, but what you have above is one great long string of text. Is that intentional?
 
Hi Ken,

Thanks for your reply.
Ok, it seems i faced format issue and the great long string of text was not intentional at all.
Sorry for that.

Please find as attached my file.
If you check on the sheet "Region" you will see that after sorting per Region and month i get some "blocks of data".
I need to calculate for each "blocks of data" the sumproduct of the column J with the column M, then column K with column M, etc....

Basically, the extraction of data will be done on monthly basis.

The difficulty is since the data is a dynamic range, next month the example of area J2:J4, may become J2:J10 or only J2, and the inserted row will not be at the same place as well, from one month to the other one. but the results of my calculation must always be in that inserted row.

Hope the above info will help to clarify, and with the attached file.

Thanks again for your good help,
Lomic6
 

Attachments

  • VBA Test_07252011.xlsm
    54.4 KB · Views: 40
Hi Lomic,

Sorry for the late reply here, it's been nutty busy over the last few days.

Out of curiosity, can you make the month longer? I'm not sure I have the formula correct as I'm not quite getting the whole gist of the calculation, but if you just want to multiply ColJ by ColM: =SUMPRODUCT(--($B$1:$B4=$B4),J$1:J4,M$1:M4)

So if you put that in row 5, it would multiply all the col J by col M entries where the Month equals what is in B4.
 
Hi Ken,

Yes, generally speaking I want to multiply ColJ by ColM for each block of data that will appear after the sorting step. But i need also the program to divide, for each block of data, the sumproduct ColJ*ColM result by the respective block sum ColM result.
I don't want to have to put the formula in Row 5 manually. I need the program to detect the empty fields automatically and to insert automatically the information.

Have you been able to run the macro on my previous file ?
I have made the month longer in the Sheet "Region" after the sorting (see attached)

Cheers,
Lomic
 

Attachments

  • New VBA Test_07202011v3.xlsm
    59 KB · Views: 25
Can I get you to just step back a bit on this one? I totally misread the first part of the post. Let's regress back to the first example file you gave here.

So, I get that you've got your SUM formulas in M, N, S and T

Where are these SUMPRODUCT formulas supposed to go? I.e. What is the formula that you'd expect to in J5, K5, O5 P5 and Q5? To me, then lend to totals, not sumproducts.

(FYI, I'm going to be out of town from Sunday, but if I'll try and get you sorted before I leave if I can.)

Cheers,
 
Hi

I think the code below will set the formulae for both your SUM and SUMPRODUCT requirements in the sheet

Code:
Option Explicit
Sub mySubT2Region()

    Dim aArea As Range
    Dim fr As Long, lr As Long, x As Long

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Worksheets("Region").Select

    For Each aArea In ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants).Areas
        Rows(aArea.Row + aArea.Rows.Count).Font.ColorIndex = 3
        Rows(aArea.Row + aArea.Rows.Count).Font.Bold = True

        fr = Application.Max(2, aArea(1).Row)
        lr = aArea(aArea.Cells.Count).Row
        x = lr - fr + 1
        ' Fill in SUM's
        Cells(lr + 1, 13).FormulaR1C1 = "=SUM(R[-" & x & "]C:R[-1]C)"
        Cells(lr + 1, 14).FormulaR1C1 = "=SUM(R[-" & x & "]C:R[-1]C)"
        Cells(lr + 1, 18).FormulaR1C1 = "=SUM(R[-" & x & "]C:R[-1]C)"
        Cells(lr + 1, 19).FormulaR1C1 = "=SUM(R[-" & x & "]C:R[-1]C)"
        Cells(lr + 1, 20).FormulaR1C1 = "=SUM(R[-" & x & "]C:R[-1]C)"
        'Fill in SUMPRODUCTS
        Cells(lr + 1, 10).FormulaR1C1 = "=SUMPRODUCT(R[-" & x & "]C:R[-1]C,R[-" & x & "]C[3]:R[-1]C[3])/RC[3]"
        Cells(lr + 1, 11).FormulaR1C1 = "=SUMPRODUCT(R[-" & x & "]C:R[-1]C,R[-" & x & "]C[2]:R[-1]C[2])/RC[2]"
        Cells(lr + 1, 12).FormulaR1C1 = "=SUMPRODUCT(R[-" & x & "]C:R[-1]C,R[-" & x & "]C[1]:R[-1]C[1])/RC[1]"
        Cells(lr + 1, 15).FormulaR1C1 = "=SUMPRODUCT(R[-" & x & "]C:R[-1]C,R[-" & x & "]C[3]:R[-1]C[3])/RC[3]"
        Cells(lr + 1, 16).FormulaR1C1 = "=SUMPRODUCT(R[-" & x & "]C:R[-1]C,R[-" & x & "]C[2]:R[-1]C[2])/RC[2]"
        Cells(lr + 1, 17).FormulaR1C1 = "=SUMPRODUCT(R[-" & x & "]C:R[-1]C,R[-" & x & "]C[1]:R[-1]C[1])/RC[1]"

    Next aArea

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

End Sub
 
Hi Roger,

It is amazing, and it work perfectly !!!
I am not familiar at all with the R1C1 language.
Is there a way to translate this coding into a VBA coding format like my previous one ?

Anyway thank you so much for your GREAT help ! :)

Cheers,
Lomic
 
Or do you mind to ellaborate your R1C1 coding for me to understand, correctly ?

Thank again,
Lomic
 
R1C1 just uses numeric column and row ids, whereas the A1 notation uses letters for the columns. It is not absolutely necessary, but in VBA it is often convenient because formulas are often set in loops, and loops have a numeric index.
 
BTW, here is a way using A1

Code:
Sub mySubT2Region()
    Dim aArea As Range
    Dim fr As Long, lr As Long, x As Long

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Worksheets("Region").Select

    For Each aArea In ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants).Areas
        Rows(aArea.Row + aArea.Rows.Count).Font.ColorIndex = 3
        Rows(aArea.Row + aArea.Rows.Count).Font.Bold = True

        fr = Application.Max(2, aArea(1).Row)
        lr = aArea(aArea.Cells.Count).Row
        x = lr - fr + 1
        ' Fill in SUM's
        Cells(lr + 1, 13).Resize(, 2).Formula = "=SUM(M" & fr & ":M" & lr & ")"
        Cells(lr + 1, 18).Resize(, 3).Formula = "=SUM(R" & fr & ":R" & lr & ")"
        'Fill in SUMPRODUCTS
        Cells(lr + 1, 10).Resize(, 3).Formula = "=SUMPRODUCT(J" & fr & ":J" & lr & ",$M" & fr & ":$M" & lr & ")/$M" & lr + 1
        Cells(lr + 1, 15).Resize(, 3).Formula = "=SUMPRODUCT(O" & fr & ":O" & lr & ",$R" & fr & ":$R" & lr & ")/$R" & lr + 1
    Next aArea

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub
 
Hi Bob,

Thank you so much for your additional info.

Cheers,
Lomic
 
How to Copy the results of the SUM and SUMPRODUCT to a different worksheet

Hi Roger, Bob,

Regarding my previous topics, i have a new request.
After the sorting and calculation of my data, i need to copy those results, as a value, to a new worksheet, to be used to generate automatically charts.
The data in the column C and D will need to be used as a condition to copy the results to such or such data table in the new worksheet (one data table per chart).

What would be the coding to automate the copying of the results to this new worksheets knowing that the source is still in dynamic cell to a destination that will be in fix cell ?

Thanks in advance for your help,
Lomic6
 
Hi Lomic

I'm not sure exactly what you want to do, but the following code will copy all of your data to a new sheet as fixed values

Code:
Sub CopyData()
  
    Sheets("Region").UsedRange.Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    Selection.PasteSpecial Paste:=xlPasteValues
End Sub
 
Hi Roger,

Thanks for your prompt reply.

Please find as attached my file for easier reference.

Basically after the sorting be executed (Ctrl+Shift+S) you will see the calculation results in blue bold color in the sheet "Region". these results are for different month and different region.
I need these blue results to be copied automatically in the sheet "ChartRegion" in their specific data table,s, which will become the source for the chart generation.
I assume that column B and C will be a condition.

The tricky part is the row with the blue bold color results are fluctuating. For example the result actually in J5 can be in J8 or J3 the next time.

Hope the above info will help to clarify my expectation, otherwise let me know.

Thanks for your help,
Lomic6
 

Attachments

  • New VBA Test_08312011.xlsm
    76.1 KB · Views: 16
Hi Lomic

You can write extra information to the rows containing the data you want, as part of the routine which creates the SUM and SUMPRODUCTdata, then filter for these rows in the copying procedure as shown below, and in the attached file.

Code:
Sub CopyDataRegion()
    Dim c As Range, typ As String, tr As Long, month As Long
    Dim output(6)
    Dim wsS As Worksheet, wsD As Worksheet
    Set wsS = Sheets("Region")
    Set wsD = Sheets("ChartRegion")
    Application.ScreenUpdating = False
    wsS.Activate
    wsS.UsedRange.AutoFilter Field:=23, Criteria1:="<>"
    For Each c In wsS.Range("X:X").SpecialCells(12)
        tr = c.Row
        If tr <> 1 Then
            output(1) = wsS.Cells(tr, "O").Value
            output(2) = wsS.Cells(tr, "J").Value
            output(3) = wsS.Cells(tr, "K").Value
            output(4) = wsS.Cells(tr, "P").Value
            output(5) = wsS.Cells(tr, "L").Value
            output(6) = wsS.Cells(tr, "Q").Value
            month = wsS.Cells(tr, "W").Value
            typ = wsS.Cells(tr, "X").Value


            If typ = "GC" Then
                wsD.Range("A4").Offset(, month).Resize(6, 1) = WorksheetFunction.Transpose(output)
            ElseIf typ = "SA" Then
                wsD.Range("A14").Offset(, month).Resize(6, 1) = WorksheetFunction.Transpose(output)
            Else
                GoTo exit_sub
            End If


            output(1) = wsS.Cells(tr, "S").Value
            output(2) = wsS.Cells(tr, "T").Value
            output(3) = wsS.Cells(tr, "N").Value
            output(4) = wsS.Cells(tr, "R").Value
            output(5) = wsS.Cells(tr, "M").Value
            output(6) = wsS.Cells(tr, "U").Value


            If typ = "GC" Then
                wsD.Range("U4").Offset(, month).Resize(6, 1) = WorksheetFunction.Transpose(output)
            ElseIf typ = "SA" Then
                wsD.Range("U14").Offset(, month).Resize(6, 1) = WorksheetFunction.Transpose(output)
            Else
                GoTo exit_sub
            End If
End If
        Next
exit_sub:
        wsS.AutoFilterMode = False
        Application.ScreenUpdating = True
    End Sub

I have amended some of your other code as well. There is no need to loop whn copying the data from Master, it can all be copied in a single block.

I amended your myMonth routine to simplify it and make it faster
Code:
Sub myMonth()
Dim lr As Long, i As Long
lr = Sheets("Activity").Cells(Rows.Count, 1).End(xlUp).Row


For i = 2 To lr
If Cells(i, 2) <> "" Then
Cells(i, 2) = MonthName(Cells(i, 2).Value)
End If
Next
End Sub

Although I have emended your myMonth routine, I have suppressed it being called, as it is easier to get the column offset for writing the data out from the month Number rather than the month text.
If you do want Month Names in Sheet Region, then call the routine AFTER the cahrat data has been copied.

I amended part of your mySubT2Act as well as I couldn't see why you were trying to apply an average in column U as it only contains Text data. You can see where I have added the information for the chart copy routine to pick up Month and Type

Code:
   'Fill in SUM Divide
        Cells(lr + 1, 18).FormulaR1C1 = "=AVERAGE(R[-" & x & "]C:R[-1]C)"
        'Cells(lr + 1, 21).FormulaR1C1 = "=AVERAGE(R[-" & x & "]C:R[-1]C)"
        
        'Fill in Chart row
         Cells(lr + 1, 23) = Cells(lr, 2).Value
         Cells(lr + 1, 24) = Cells(lr, 3).Value
    Next aArea
 

Attachments

  • New VBA Test_08312011 #2.xlsm
    88.6 KB · Views: 26
Hi Roger,

Thanks again for your GREAT help !
It works perfectly and i can generate my charts instantaneously. Thank you so much.

Regarding your question on mySubT2Act, i will have value number in this column, that's why i anticipated the coding for it.

Regarding the code sentence:
Code:
For Each c In wsS.Range ("X:X").SpecialsCells(12)

What the value (12) means ? How do i need to interpret it ?

I need to add a value number for each row in the column V. in the "Master" sheet. This value can be positive or negative.
During the sorting and calculating process from "Master" sheet to become "Region" sheet, I need to calculate the SUM, between the value in J. and the value in V. of the same row (i.e: J2+V2, J3+V3, J4+V4...). The result will become the new J2, J3, J4..., value in the "Region" sheet.

I wrote the following code:
Code:
Cells(lr + 1, 10).FormulaR1C1 = "=SUM(R[-" & "]C + R[-" & "]C[12])"

When i try putting any value in V. I have no error message but there is no change in the "new" J. value, as well.
I guess there is a gap somewhere, but cannot figure out where it is.

Thanks for your advice,
Lomic6
 
Hi Lomic
What the value (12) means ? How do i need to interpret it ?

The (12) is the same as Special Cells XLVisible, so we are only working through the cells which are visible after the filter has been applied. Row 1 will be visible because it is the header, but we do not need to process it, hence the test fro row 1.
By using the Visible property, it saves looping through lots of blanks cells wuth a test each time to see if they contain data.

Knowing now that column V will contain Values, then my remming out of the Average can be removed.
To add the value of column V to the value of column J

Code:
  'Fill in AVERAGE
        Cells(lr + 1, 18).FormulaR1C1 = "=AVERAGE(R[-" & x & "]C:R[-1]C)"
        Cells(lr + 1, 21).FormulaR1C1 = "=AVERAGE(R[-" & x & "]C:R[-1]C)"
        Cells(lr + 1, 10).FormulaR1C1 "=SUMPRODUCT(R[-3]C:R[-1]C,R[-3]C[3]:R[-1]C[3])/RC[3]+RC[11]"

Note the +RC[11] at the end of the formula
 
Hi Roger,

Thank you very much for your complementary explanation.

Regarding the calculation with the value in "V" i am facing some issue.

Please allow me to re-explain and clarify the expected results.

Lets say in sheet "Master", J2 = 14, J3 = 20, J4 = 7, ... , and V2 = 3, V3 = -7, V4 = 5, ...

When the program copy the data from sheet "Master" to sheet "Region", the Sheet "Region" should show the results of the SUM between J and V. : J2+V2, J3+V3, etc...

So, in Sheet "Region" the new "J" value should be: J2 = 17, J3 = 13, J4 = 12, etc... At this step it is just a SUM calculation not a SUMPRODUCT.

Then, based on this new "J" value the program will apply the SUMPRODUCT formula we already have.

Thanks again for your time and your help,
Lomic6
 
Hi Lomic

I understand what you are asking.
In which case, the addition of cells J and V needs to take place before we get to the Sum and Sumproduct calculations.

I would place it in the WorksheetSort1 routine as shown below. Note the dimensioning of lr and i to allow the loop for adding column J to column V

Code:
'Sorting of the Data Region


' Keyboard Ctrl + Shift + S


Sub WorkSheetSort1()


' Declare the variable
Dim Rw As Range
Dim Column As Long, lr As Long, i As Long


Application.ScreenUpdating = False


' Define the selected area
Worksheets("Region").Cells.Delete
' Define the selected area
Worksheets("Master").Select
ActiveCell.SpecialCells(xlLastCell).Select
Range(Selection, Cells(1)).Copy Worksheets("Region").Range("A1")


'Select the Worksheet "Region"
Worksheets("Region").Activate

' ***** new section *****
lr = Cells(Rows.Count, 1).End(xlUp).Row
' Add column V to column J
For i = 2 To lr
Cells(i, 10) = Cells(i, 10) + Cells(i, 21)
Next i
' ****  end of new section *****



'Sorting
Range("A:V").Sort Key1:=Range("C2"), Order1:=xlAscending, _
Key2:=Range("B2"), Order2:=xlYes, Header:=xlYes, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom


'Call to convert the Month
'Call myMonth


'Call to insert line on Region and Month column
Call InsertRows1


'Call to calculate the SUM.
Call mySubT2Region


'Call to adjust automatically the size of the Columns and Rows
Call myAutoFit


Call CopyDataRegion


End Sub
 
Back
Top