Solved: Sum a column based on two column values

[mvandhu]

Hi all,
I need VBA code for a macro to be developed.

Scenario:

I have 4 columns in sheet 1.
For example,
ID1 ID2 Sum1 Sum2
100 a 10 12
101 a 20 11
100 a 10 07
100 b 30 05
100 b 15 20
101 c 20 10

In sheet2 my sum1 and sum2 should be calculated based on ID1 and ID2.
i.e. My result in sheet2 should be as
ID1 ID2 Sum1 Sum2
100 a 20 19
100 b 45 25
101 a 20 11
101 c 20 10

The rows count always varies.:help

[Bob Phillips]

Public Sub ProcessData()
Dim sh As Worksheet
Dim Lastrow As Long
Dim Nextrow As Long
Dim Matchrow As Long
Dim i As Long

Application.ScreenUpdating = False

Set sh = Worksheets("Sheet2")

With ActiveSheet

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

.Range("A1:D1").Copy sh.Range("A1")
Nextrow = 2

For i = 2 To Lastrow

Matchrow = 0
On Error Resume Next
Matchrow = Application.Evaluate("SUMPRODUCT(--(A" & i & "=Sheet2!A1:A200)," & _
"--(B" & i & "=Sheet2!B1:B200),ROW(Sheet2!A1:A200))")
On Error GoTo 0
If Matchrow = 0 Or Matchrow > 200 Then

.Cells(i, "A").Resize(, 4).Copy sh.Cells(Nextrow, "A")
Nextrow = Nextrow + 1
Else

sh.Cells(Matchrow, "C").Value = sh.Cells(Matchrow, "C").Value + .Cells(i, "C").Value
sh.Cells(Matchrow, "D").Value = sh.Cells(Matchrow, "D").Value + .Cells(i, "D").Value
End If
Next i
End With

Application.ScreenUpdating = True
End Sub

[mvandhu]

Yipeeeeeee.......:rotlaugh: Hey its workin well...:clap: thanks a lot for your code...

[mvandhu]

Hi xld..
I have a doubt in the below mentioned part of your code.

Matchrow = Application.Evaluate("SUMPRODUCT(--(A" & i & "=Sheet2!A1:A200)," & _ "--(B" & i & "=Sheet2!B1:B200),ROW(Sheet2!A1:A200))")

Will this code work only for 200 records? or What does that A200 or B200 signify?

[mvandhu]

Because am having more than 1000 records for which the sum has to be done based on 2 columns. sometimes my record count even exceeds nearly 10,000 or more. Your code works well only for the 1st 200 records. After that the sum is not done.

[Bob Phillips]

Create a dynamic range for the data and use that in the formula.

[mvandhu]

Thank you...

[visible2you]

Awesome XLD... you are Genius.

[mvandhu]

xld..

What if the sum is based on 3 columns?? Is ter option that we can alter in the above code to calculate the sum of the column based on 3 columns?? if so, can you mention the code tat should be added to the above code??


Thanks in advance...

[Bob Phillips]

Public Sub ProcessData()
Dim sh As Worksheet
Dim Lastrow As Long
Dim Nextrow As Long
Dim Matchrow As Long
Dim i As Long

Application.ScreenUpdating = False

Set sh = Worksheets("Sheet2")

With ActiveSheet

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

.Range("A1:D1").Copy sh.Range("A1")
Nextrow = 2

For i = 2 To Lastrow

Matchrow = 0
On Error Resume Next
Matchrow = Application.Evaluate("SUMPRODUCT(--(A" & i & "=Sheet2!A1:A200)," & _
"--(B" & i & "=Sheet2!B1:B200),ROW(Sheet2!A1:A200))")
On Error GoTo 0
If Matchrow = 0 Or Matchrow > 200 Then

.Cells(i, "A").Resize(, 4).Copy sh.Cells(Nextrow, "A")
Nextrow = Nextrow + 1
Else

sh.Cells(Matchrow, "C").Value = sh.Cells(Matchrow, "C").Value + .Cells(i, "C").Value
sh.Cells(Matchrow, "D").Value = sh.Cells(Matchrow, "D").Value + .Cells(i, "D").Value
sh.Cells(Matchrow, "E").Value = sh.Cells(Matchrow, "E").Value + .Cells(i, "E").Value '<<<<<<<<<<<<<<<<<<<<
End If
Next i
End With

Application.ScreenUpdating = True
End Sub

[mvandhu]

Hi XLD... Thanks for ur reply. But this is the scenario...

I have 5 columns in sheet 1.
For example,
ID1 ID2 ID3 Sum1 Sum2
100 a xx 10 12
101 a xx 20 11
100 a xx 10 07
100 b xy 30 05
100 b xy 15 20
101 c xx 20 10

In sheet2 my sum1 and sum2 should be calculated based on ID1, ID2 and ID3.
i.e. My result in sheet2 should be as

ID1 ID2 ID3 Sum1 Sum2
100 a xx 20 19
101 a xx 20 11
100 b xy 45 25
101 c xx 20 10

[Bob Phillips]

This should work



Public Sub ProcessData()
Dim sh As Worksheet
Dim Lastrow As Long
Dim Nextrow As Long
Dim Matchrow As Long
Dim i As Long

Application.ScreenUpdating = False

Set sh = Worksheets("Sheet2")

With ActiveSheet

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

.Range("A1:E1").Copy sh.Range("A1")
Nextrow = 2

For i = 2 To Lastrow

Matchrow = 0
On Error Resume Next
Matchrow = Application.Evaluate("SUMPRODUCT(--(A" & i & "=Sheet2!A1:A200)," & _
"--(B" & i & "=Sheet2!B1:B200),--(C" & i & "=Sheet2!C1:C200),ROW(Sheet2!A1:A200))")
On Error GoTo 0
If Matchrow = 0 Or Matchrow > 200 Then

.Cells(i, "A").Resize(, 5).Copy sh.Cells(Nextrow, "A")
Nextrow = Nextrow + 1
Else

sh.Cells(Matchrow, "D").Value = sh.Cells(Matchrow, "D").Value + .Cells(i, "D").Value
sh.Cells(Matchrow, "E").Value = sh.Cells(Matchrow, "E").Value + .Cells(i, "E").Value
End If
Next i
End With

Application.ScreenUpdating = True
End Sub