Printable View
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
[VBA]
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[/VBA]
Yipeeeeeee.......:rotlaugh: Hey its workin well...:clap: thanks a lot for your code...
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?
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.
Create a dynamic range for the data and use that in the formula.
Thank you...
Awesome XLD... you are Genius.
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...
[vba]
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[/vba]
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
This should work
[vba]
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[/vba]