Data Sum Up Macro

Rado88

New Member
Joined
Dec 30, 2017
Messages
45
Hi

I'm trying to improve my macro skills and create a MACRO that would calculate sum from purchase/sales made by a client in different offices. However I've encountered some issues and I'm not sure how to proceed further.

Example - I've a data sheet with client name buy amount sell amount and where they were made. It looks like this (the product names and clients are made up, however the data I'm looking for would always be in those columns):
[TABLE="class: grid, width: 500, align: left"]
<tbody>[TR]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[TD]F[/TD]
[TD]G[/TD]
[TD]H[/TD]
[TD]I[/TD]
[TD]J[/TD]
[TD]K[/TD]
[TD]L[/TD]
[TD]M[/TD]
[TD]N[/TD]
[/TR]
[TR]
[TD]Data[/TD]
[TD]Data[/TD]
[TD]Client name[/TD]
[TD]Data[/TD]
[TD]Data[/TD]
[TD]Data[/TD]
[TD]Data[/TD]
[TD]Buy product[/TD]
[TD]BQuantity[/TD]
[TD]Sell product[/TD]
[TD]Sell Quantity[/TD]
[TD]Data[/TD]
[TD]Data[/TD]
[TD]Data[/TD]
[/TR]
[TR]
[TD]Data[/TD]
[TD]Data[/TD]
[TD]John[/TD]
[TD]xxx[/TD]
[TD]Data[/TD]
[TD]Data[/TD]
[TD]Data[/TD]
[TD]Wood[/TD]
[TD]1000[/TD]
[TD]metal[/TD]
[TD]555[/TD]
[TD]Data[/TD]
[TD]Data[/TD]
[TD]Data[/TD]
[/TR]
[TR]
[TD]Data[/TD]
[TD]Data[/TD]
[TD]Tim[/TD]
[TD]xxx[/TD]
[TD]Data[/TD]
[TD]Data[/TD]
[TD]Data[/TD]
[TD]Coal[/TD]
[TD]230[/TD]
[TD]Wood[/TD]
[TD]1000[/TD]
[TD]Data[/TD]
[TD]Data[/TD]
[TD]Data[/TD]
[/TR]
[TR]
[TD]Data[/TD]
[TD]Data[/TD]
[TD]John[/TD]
[TD]xxx[/TD]
[TD]Data[/TD]
[TD]Data[/TD]
[TD]Data[/TD]
[TD]metal[/TD]
[TD]1000[/TD]
[TD]Wood[/TD]
[TD]220[/TD]
[TD]Data[/TD]
[TD]Data[/TD]
[TD]Data[/TD]
[/TR]
[TR]
[TD]Data[/TD]
[TD]Data[/TD]
[TD]Xyz[/TD]
[TD]xxx[/TD]
[TD]Data[/TD]
[TD]Data[/TD]
[TD]Data[/TD]
[TD]metal[/TD]
[TD]500[/TD]
[TD]Coal[/TD]
[TD]1000[/TD]
[TD]Data[/TD]
[TD]Data[/TD]
[TD]Data[/TD]
[/TR]
[TR]
[TD]Data[/TD]
[TD]Data[/TD]
[TD]Xyz[/TD]
[TD]xxx[/TD]
[TD]Data[/TD]
[TD]Data[/TD]
[TD]Data[/TD]
[TD]Coal[/TD]
[TD]1000[/TD]
[TD]Wood[/TD]
[TD]1500[/TD]
[TD]Data[/TD]
[TD]Data[/TD]
[TD]Data[/TD]
[/TR]
[TR]
[TD]Data[/TD]
[TD]Data[/TD]
[TD]Ron[/TD]
[TD]xxx[/TD]
[TD]Data[/TD]
[TD]Data[/TD]
[TD]Data[/TD]
[TD]Wood[/TD]
[TD]2500[/TD]
[TD]Coal[/TD]
[TD]200[/TD]
[TD]Data[/TD]
[TD]Data[/TD]
[TD]Data[/TD]
[/TR]
[TR]
[TD]Data[/TD]
[TD]Data[/TD]
[TD]Ron[/TD]
[TD]xxx[/TD]
[TD]Data[/TD]
[TD]Data[/TD]
[TD]Data[/TD]
[TD]Wood[/TD]
[TD]1000[/TD]
[TD]metal[/TD]
[TD]40[/TD]
[TD]Data[/TD]
[TD]Data[/TD]
[TD]Data[/TD]
[/TR]
[TR]
[TD]Data[/TD]
[TD]Data[/TD]
[TD]John[/TD]
[TD]xxx[/TD]
[TD]Data[/TD]
[TD]Data[/TD]
[TD]Data[/TD]
[TD]Paper[/TD]
[TD]111[/TD]
[TD]Wood[/TD]
[TD]67[/TD]
[TD]Data[/TD]
[TD]Data[/TD]
[TD]Data[/TD]
[/TR]
</tbody>[/TABLE]




The above data will change per each trade date.

What I would like to make from this data table, is to creata a button which whne pressed, would copy the above data into new sheet (created in same workbook) and remove duplicates. At the end it should sum up the sales for each product and add the results with product name name near the client. The end product should look like this in sheet(2):

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[/TR]
[TR]
[TD]Client name[/TD]
[TD]product[/TD]
[TD]Quantity[/TD]
[/TR]
[TR]
[TD]John[/TD]
[TD]Wood[/TD]
[TD]1933[/TD]
[/TR]
[TR]
[TD]John[/TD]
[TD]metal[/TD]
[TD]-555[/TD]
[/TR]
[TR]
[TD]John[/TD]
[TD]Paper[/TD]
[TD]111[/TD]
[/TR]
[TR]
[TD]Ron[/TD]
[TD]Wood[/TD]
[TD]3500[/TD]
[/TR]
[TR]
[TD]Ron[/TD]
[TD]Coal[/TD]
[TD]-200[/TD]
[/TR]
[TR]
[TD]Ron[/TD]
[TD]metal[/TD]
[TD]-40[/TD]
[/TR]
[TR]
[TD]Tim[/TD]
[TD]Wood[/TD]
[TD]-1000[/TD]
[/TR]
[TR]
[TD]Tim[/TD]
[TD]Coal[/TD]
[TD]230[/TD]
[/TR]
[TR]
[TD]Xyz[/TD]
[TD]Wood[/TD]
[TD]1500[/TD]
[/TR]
[TR]
[TD]Xyz[/TD]
[TD]Coal[/TD]
[TD]0[/TD]
[/TR]
[TR]
[TD]Xyz[/TD]
[TD]metal[/TD]
[TD]500[/TD]
[/TR]
</tbody>[/TABLE]

Alternatively the above could be shown in such format

[TABLE="width: 500"]
<tbody>[TR]
[TD]A[/TD]
[TD]B[/TD]
[/TR]
[TR]
[TD]John (in A1 merged with B1)[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Wood[/TD]
[TD]1933[/TD]
[/TR]
[TR]
[TD]metal[/TD]
[TD]-555[/TD]
[/TR]
[TR]
[TD]Paper[/TD]
[TD]111[/TD]
[/TR]
</tbody>[/TABLE]

It would be easy to sum up the values using sumifs function in my macro, however I'm not sure how to make VBA create a new table each time when the product names and client names will differ (to add search criteria for sumifs). Excel can loop through the data sheet each time new data file is added, but how to make sure that all the products will be added only once (from buy and sell column) and that nothing will be omitted (not to mention the correct format) ;/

The products and clients may change each time a new file with data is copied into macro sheet.

Would it be possible to add a cell colour in the alternative method mentioned above?

Thank you very much in advance for your help :)
 
Last edited:

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand
Re: Data Sum Up Macro - can't find any solution :(

If you convert your 'raw data' into a Table (or List Object), you could filter it A-Z by client name. In Excel 2016, inserting a Table is done by selecting any cell of the raw data then using the shortcut Alt + N + T.

Would that achieve what you are trying to do?
 
Upvote 0
Re: Data Sum Up Macro - can't find any solution :(

How about
Code:
Sub Createreport()
   Dim Cl As Range
   Dim Dic As Object
   Dim Ky As Variant, k As Variant
   
   Set Dic = CreateObject("scripting.dictionary")
   With Sheets("Sheet1")
      For Each Cl In .Range("C2", .Range("C" & Rows.Count).End(xlUp))
         If Not Dic.Exists(Cl.Value) Then
            Dic.Add Cl.Value, CreateObject("scripting.dictionary")
            Dic(Cl.Value)(Cl.Offset(, 5).Value) = Dic(Cl.Value)(Cl.Offset(, 5).Value) + Cl.Offset(, 6).Value
            Dic(Cl.Value)(Cl.Offset(, 7).Value) = Dic(Cl.Value)(Cl.Offset(, 7).Value) + -Cl.Offset(, 8).Value
         Else
            Dic(Cl.Value)(Cl.Offset(, 5).Value) = Dic(Cl.Value)(Cl.Offset(, 5).Value) + Cl.Offset(, 6).Value
            Dic(Cl.Value)(Cl.Offset(, 7).Value) = Dic(Cl.Value)(Cl.Offset(, 7).Value) + -Cl.Offset(, 8).Value
         End If
      Next Cl
   End With
   With Sheets("Sheet2")
      .Range("A1:C1").Value = Array("Client name", "Product", "Quantity")
      For Each Ky In Dic.keys
         For Each k In Dic(Ky)
         With .Range("A" & Rows.Count).End(xlUp)
            .Offset(1).Value = Ky
            .Offset(1, 1).Value = k
            .Offset(1, 2).Value = Dic(Ky)(k)
         End With
         Next k
      Next Ky
   End With
End Sub
 
Upvote 0
Re: Data Sum Up Macro - can't find any solution :(

@Fluff

Thank you very much for your help, it looks like everything is working fine. May I only ask if it's possible to create a macro that would copy this newly created table and add it tow "print page"? I mean I would like to save the file as PDF with and add each table to a new print area (if I press a macro button a new area is created and the data created by above macro is moved to it on Sheet with cover page in excel (one after each click)). I'm trying to find a solution, how to do this but without luck till now.
 
Last edited:
Upvote 0
Re: Data Sum Up Macro - can't find any solution :(

As this is a different question, can you please start a new thread.
Cheers
 
Upvote 0
Re: Data Sum Up Macro - can't find any solution :(

As this is a different question, can you please start a new thread.
Cheers

@Fluff

May I ask for your help with one last thing?

Your Above macro is working great. However on one of my excel sheets I encountered a problem. I need to add one more text collumn.

Collumn A
1) John
2) John
3) John

Collumn B (E on data sheet)
1) Kowalski
2) Carter
3) Snow

Collumn C
The same product but the "John" amounts have to be divided to John Kowalski, John Carter and John Snow if they bought anything.

So instead of John Wood 1000 the macro would have to show

John Snow Wood 600
John Carter Wood 300
John Kowalski Wood 1000.

In sheet2 collumns A B C and D.

Sorry for The extra trouble :(
 
Upvote 0
Re: Data Sum Up Macro - can't find any solution :(

Untested, but try
Code:
Sub Createreport()
   Dim Cl As Range
   Dim Dic As Object
   Dim Ky As Variant, K As Variant
   Dim v1 As String
   
   Set Dic = CreateObject("scripting.dictionary")
   With Sheets("Sheet1")
      For Each Cl In .Range("C2", .Range("C" & Rows.Count).End(xlUp))
         v1 = Cl.Value & "," & Cl.Offset(, 2).Value
         If Not Dic.exists(v1) Then
            Dic.Add v1, CreateObject("scripting.dictionary")
            Dic(v1)(Cl.Offset(, 5).Value) = Dic(v1)(Cl.Offset(, 5).Value) + Cl.Offset(, 6).Value
            Dic(v1)(Cl.Offset(, 7).Value) = Dic(v1)(Cl.Offset(, 7).Value) + -Cl.Offset(, 8).Value
         Else
            Dic(v1)(Cl.Offset(, 5).Value) = Dic(v1)(Cl.Offset(, 5).Value) + Cl.Offset(, 6).Value
            Dic(v1)(Cl.Offset(, 7).Value) = Dic(v1)(Cl.Offset(, 7).Value) + -Cl.Offset(, 8).Value
         End If
      Next Cl
   End With
   With Sheets("Print Page")
      .Range("A1:C1").Value = Array("Client name", "Product", "Quantity")
      For Each Ky In Dic.keys
         For Each K In Dic(Ky)
         With .Range("A" & Rows.Count).End(xlUp)
            .Offset(1).Value = Ky
            .Offset(1, 1).Value = K
            .Offset(1, 2).Value = Dic(Ky)(K)
         End With
         Next K
      Next Ky
   End With
End Sub
 
Upvote 0
Thank you fluff but The Code doesn't seem to work :(

I tried to adjust it all night but can't get it to work :(

I need 4 collumns not 3 for this on sheet2 :(
 
Last edited:
Upvote 0
How about
Code:
      For Each Ky In Dic.keys
         For Each K In Dic(Ky)
         With .Range("A" & Rows.Count).End(xlUp)
            .Offset(1).Resize(, 2).Value = Split(Ky, ",")
            .Offset(1, 2).Value = K
            .Offset(1, 3).Value = Dic(Ky)(K)
         End With
         Next K
      Next Ky
 
Upvote 0

Forum statistics

Threads
1,223,227
Messages
6,170,847
Members
452,361
Latest member
d3ad3y3

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
Back
Top