Data Sum Up Macro

[Rado88]

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):

A

B

C

D

E

F

G

H

I

J

K

L

M

N

Data

Data

Client name

Data

Data

Data

Data

Buy product

BQuantity

Sell product

Sell Quantity

Data

Data

Data

Data

Data

John

xxx

Data

Data

Data

Wood

1000

metal

555

Data

Data

Data

Data

Data

Tim

xxx

Data

Data

Data

Coal

230

Wood

1000

Data

Data

Data

Data

Data

John

xxx

Data

Data

Data

metal

1000

Wood

220

Data

Data

Data

Data

Data

Xyz

xxx

Data

Data

Data

metal

500

Coal

1000

Data

Data

Data

Data

Data

Xyz

xxx

Data

Data

Data

Coal

1000

Wood

1500

Data

Data

Data

Data

Data

Ron

xxx

Data

Data

Data

Wood

2500

Coal

200

Data

Data

Data

Data

Data

Ron

xxx

Data

Data

Data

Wood

1000

metal

40

Data

Data

Data

Data

Data

John

xxx

Data

Data

Data

Paper

111

Wood

67

Data

Data

Data

<tbody>
</tbody>

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):

A	B	C
Client name	product	Quantity
John	Wood	1933
John	metal	-555
John	Paper	111
Ron	Wood	3500
Ron	Coal	-200
Ron	metal	-40
Tim	Wood	-1000
Tim	Coal	230
Xyz	Wood	1500
Xyz	Coal	0
Xyz	metal	500

<tbody>
</tbody>

Alternatively the above could be shown in such format

A	B
John (in A1 merged with B1)
Wood	1933
metal	-555
Paper	111

<tbody>
</tbody>

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

 

[deadlyduck]

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?

 

[Fluff]

Re: Data Sum Up Macro - can't find any solution

How about

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

 

[Rado88]

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.

 

[Fluff]

Re: Data Sum Up Macro - can't find any solution

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

 

[Rado88]

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

 

[Fluff]

Re: Data Sum Up Macro - can't find any solution

Untested, but try

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

 

[Rado88]

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

 

[Fluff]

How about

      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

 

[Rado88]

No still not working - I got runtime error 424 object required as previously.