Required VBA codes solution of "SUMPRODUCT" formula

[PRADEEPB270]

I want to know the VBA codes workings on an excel formula i.e."SUMPRODUCT".

Please refer my attach file.In this file,I want to achieve the results through VBA codes of columns Z to AD only.Yes,an extra working,which is required is Column Y i.e."Remarks" through automate input by VBA working.

Is that possible through VBA codes scenario?

[Rudi]

I want to know the VBA codes workings on an excel formula i.e."SUMPRODUCT".

Please refer my attach file.In this file,I want to achieve the results through VBA codes of columns Z to AD only.Yes,an extra working,which is required is Column Y i.e."Remarks" through automate input by VBA working.

Is that possible through VBA codes scenario?

Hi Pradeep,

Is it really necessary to use VBA codes for this?
If formulas are not efficient enough, how about using Pivot Tables that can give you the same results in less than a minute?

2014-02-21_10h42_47.jpg

[PRADEEPB270]

Thanks Rudi for suggestions but it is really necessary to use VBA codes for this.As I want to know the VBA codes process involving an excel formula.Could you please provide the VBA codes for that purpose?
Thanks in advance.

[Rudi]

Try this:
Change starting cell references as needed...

Code: Select all

Sub CalcsQTY()
Dim rStart As Range
Set rStart = Intersect(Range("Y2").CurrentRegion, Range("Y2").CurrentRegion.Offset(2, 1))
    rStart.FormulaR1C1 = "=SUMPRODUCT((R6C22:R99960C22=RC25)*(R6C5:R99960C5=R3C)*R6C13:R99960C13)"
    rStart.Columns(rStart.Columns.Count).FormulaR1C1 = "=SUM(RC[-5]:RC[-1])"
End Sub

Sub CalcsAMT()
Dim rStart As Range
Set rStart = Intersect(Range("Y10").CurrentRegion, Range("Y10").CurrentRegion.Offset(2, 1))
    rStart.FormulaR1C1 = "=SUMPRODUCT((R6C22:R99960C22=RC25)*(R6C5:R99960C5=R11C)*R6C14:R99960C14)"
    rStart.Columns(rStart.Columns.Count).FormulaR1C1 = "=SUM(RC[-5]:RC[-1])"
End Sub

[PRADEEPB270]

Macro is working well related to Qty and Amount except left to automate insert text in column Y as "Remarks".Thanks for nice solution provide.

[Rudi]

This should add the Remarks values too...

Code: Select all

Sub CalcsQTY()
Dim rSource As Range, rStart As Range
Application.ScreenUpdating = False
Set rSource = Range("B5").CurrentRegion.Columns(Range("V5").CurrentRegion.Columns.Count)
    rSource.AdvancedFilter Action:=xlFilterCopy, Unique:=True, CopyToRange:=Range("Y3")
Set rStart = Intersect(Range("Y2").CurrentRegion, Range("Y2").CurrentRegion.Offset(2, 1))
    rStart.FormulaR1C1 = "=SUMPRODUCT((R6C22:R99960C22=RC25)*(R6C5:R99960C5=R3C)*R6C13:R99960C13)"
    rStart.Columns(rStart.Columns.Count).FormulaR1C1 = "=SUM(RC[-5]:RC[-1])"
Application.ScreenUpdating = True
End Sub

Sub CalcsAMT()
Dim rSource As Range, rStart As Range
Application.ScreenUpdating = False
Set rSource = Range("B5").CurrentRegion.Columns(Range("V5").CurrentRegion.Columns.Count)
    rSource.AdvancedFilter Action:=xlFilterCopy, Unique:=True, CopyToRange:=Range("Y11")
Set rStart = Intersect(Range("Y10").CurrentRegion, Range("Y10").CurrentRegion.Offset(2, 1))
    rStart.FormulaR1C1 = "=SUMPRODUCT((R6C22:R99960C22=RC25)*(R6C5:R99960C5=R11C)*R6C14:R99960C14)"
    rStart.Columns(rStart.Columns.Count).FormulaR1C1 = "=SUM(RC[-5]:RC[-1])"
Application.ScreenUpdating = True
End Sub

[PRADEEPB270]

Yes,it is required for perfect working.Glad to find.Once again,thanks Rudi for your cooperation.

[PRADEEPB270]

Sorry Rudi,once again.I forget to update you one problem.When,I run the VBA codes ( Qty and Amount ) then,"Sumproduct" formula' with values are appearing.It should not be appear.Only the paste special value should be appear.Can it be possible?

[Rudi]

The new code...

Code: Select all

Sub CalcsQTY()
Dim rSource As Range, rStart As Range
    Application.ScreenUpdating = False
    Set rSource = Range("B5").CurrentRegion.Columns(Range("B5").CurrentRegion.Columns.Count)
    rSource.AdvancedFilter Action:=xlFilterCopy, Unique:=True, CopyToRange:=Range("Y3")
    Set rStart = Intersect(Range("Y2").CurrentRegion, Range("Y2").CurrentRegion.Offset(2, 1))
    rStart.FormulaR1C1 = "=SUMPRODUCT((R6C22:R99960C22=RC25)*(R6C5:R99960C5=R3C)*R6C13:R99960C13)"
    rStart.Columns(rStart.Columns.Count).FormulaR1C1 = "=SUM(RC[-5]:RC[-1])"
    rStart.Copy
    rStart.PasteSpecial xlPasteValuesAndNumberFormats
    rStart.Cells(1).Select
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

Sub CalcsAMT()
Dim rSource As Range, rStart As Range
    Application.ScreenUpdating = False
    Set rSource = Range("B5").CurrentRegion.Columns(Range("B5").CurrentRegion.Columns.Count)
    rSource.AdvancedFilter Action:=xlFilterCopy, Unique:=True, CopyToRange:=Range("Y11")
    Set rStart = Intersect(Range("Y10").CurrentRegion, Range("Y10").CurrentRegion.Offset(2, 1))
    rStart.FormulaR1C1 = "=SUMPRODUCT((R6C22:R99960C22=RC25)*(R6C5:R99960C5=R11C)*R6C14:R99960C14)"
    rStart.Columns(rStart.Columns.Count).FormulaR1C1 = "=SUM(RC[-5]:RC[-1])"
    rStart.Copy
    rStart.PasteSpecial xlPasteValuesAndNumberFormats
    rStart.Cells(1).Select
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

[PRADEEPB270]

Now,the exact VBA codes in my hand to operate smooth working.Thanks Rudi for your efforts.Glad.

[Rudi]

Pleasure to help.
Have a good weekend...