simple vba code to consolidate rows (sum up amounts)

Joined
Jan 5, 2012
Messages
38
Hello, i have an excel file (sheet 1 only) that has data for 3 columns and multiple rows. The student number (ie name) are at column 1. The header is row 1.
The name of fruits (ie apple, lemon, pear, orange) are at column b and the number of fruits are at column c.

So it looks something like this below.

I know pivot table does the trick but is there a way to use code to consolidate this?


Student numberFruitsNumber of Fruits
3443apple3
3322orange2
3443apple44
5533orange1
3322orange9
5533apple4
3443orange78
5533orange3

<colgroup><col><col><col></colgroup><tbody>
</tbody>
 

Some videos you may like

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.

hurgadion

Active Member
Joined
Mar 19, 2010
Messages
426
If Your Data there is in Columns A:C try the code:
Code:
 Sub Makro1()
Dim a&, b&, i&, j&, x&

Range("E:G").ClearContents

a = Cells(Rows.Count, 1).End(xlUp).Row
Range("A1:B" & a).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("E1"), Unique:=True

b = Cells(Rows.Count, 5).End(xlUp).Row
For i = 2 To b
  x = 0
  For j = 2 To a
    If Cells(i, 5).Value = Cells(j, 1).Value And Cells(i, 6).Value = Cells(j, 2).Value Then
      x = x + Cells(j, 3).Value
    End If
  Next j
Cells(i, 7).Value = x
Next i
End Sub
Best regards.
 
Joined
Jan 5, 2012
Messages
38
Hello! Yes it works! Thanks! But it provided me with full numbers. Sometimes there are decimals (eg 5.665 in column c). Is there any way to not do rounding up? I like to keep the decimals. Thanks!



If Your Data there is in Columns A:C try the code:
Code:
 Sub Makro1()
Dim a&, b&, i&, j&, x&

Range("E:G").ClearContents

a = Cells(Rows.Count, 1).End(xlUp).Row
Range("A1:B" & a).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("E1"), Unique:=True

b = Cells(Rows.Count, 5).End(xlUp).Row
For i = 2 To b
  x = 0
  For j = 2 To a
    If Cells(i, 5).Value = Cells(j, 1).Value And Cells(i, 6).Value = Cells(j, 2).Value Then
      x = x + Cells(j, 3).Value
    End If
  Next j
Cells(i, 7).Value = x
Next i
End Sub
Best regards.
 

hurgadion

Active Member
Joined
Mar 19, 2010
Messages
426
You have to change the declaration
Code:
x&
on
Code:
x As Double
Best regards.
 

Watch MrExcel Video

Forum statistics

Threads
1,123,259
Messages
5,600,573
Members
414,389
Latest member
MarkElla

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top