Help with Reformatting/Calculating spreadsheet

[Sontauzo]

HelloAll,

I am new to the VBA world, but I have beenusing the different threads here to answer some of my more basic questions, buti have kind of a complicated one. Here goes...

I have an Excel spreadsheet that contains usertransaction data for an inventory system that we use. Each row represents aseparate transaction with specific data that needs to be analyzed. Iam trying to use VBA code to pull the relevant data and display it in a newsheet, but I am stuck. The raw data looks something like what is below. The raw data set hasabout 40 columns, and I am having troubles ignoring the extra data andcapturing the relevant stuff.


[TABLE="width: 500"]
<tbody>[TR]
[TD]User[/TD]
[TD]Item[/TD]
[TD]Transaction[/TD]
[TD]Quantity[/TD]
[/TR]
[TR]
[TD]Tom[/TD]
[TD]Hammer[/TD]
[TD]Remove[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]Tom[/TD]
[TD]Nails[/TD]
[TD]Remove[/TD]
[TD]40[/TD]
[/TR]
[TR]
[TD]Tom[/TD]
[TD]Nails[/TD]
[TD]Return[/TD]
[TD]7[/TD]
[/TR]
[TR]
[TD]Mary[/TD]
[TD]Wrench[/TD]
[TD]Remove[/TD]
[TD]2[/TD]
[/TR]
[TR]
[TD]Mary[/TD]
[TD]Hammer[/TD]
[TD]Remove[/TD]
[TD]4[/TD]
[/TR]
[TR]
[TD]Mary[/TD]
[TD]Wrench[/TD]
[TD]Return[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]Sam[/TD]
[TD]Nails[/TD]
[TD]Remove[/TD]
[TD]60[/TD]
[/TR]
[TR]
[TD]Sam[/TD]
[TD]Nails[/TD]
[TD]Return[/TD]
[TD]35[/TD]
[/TR]
[TR]
[TD]Bill[/TD]
[TD]Hammer[/TD]
[TD]Remove[/TD]
[TD]2[/TD]
[/TR]
[TR]
[TD]Bill[/TD]
[TD]Hammer[/TD]
[TD]Remove[/TD]
[TD]7[/TD]
[/TR]
[TR]
[TD]Fred[/TD]
[TD]Hammer[/TD]
[TD]Remove[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]Fred[/TD]
[TD]Nails[/TD]
[TD]Remove[/TD]
[TD]25[/TD]
[/TR]
[TR]
[TD]Fred[/TD]
[TD]Wrench[/TD]
[TD]Remove[/TD]
[TD]4[/TD]
[/TR]
[TR]
[TD]Fred[/TD]
[TD]Nails[/TD]
[TD]Return[/TD]
[TD]1[/TD]
[/TR]
</tbody>[/TABLE]


Here is the kind of output that I am looking for.

[TABLE="width: 500"]
<tbody>[TR]
[TD]User[/TD]
[TD]Item[/TD]
[TD]Quantity[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Tom[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Hammer[/TD]
[TD]1[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Nails[/TD]
[TD]33[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Mary[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Wrench[/TD]
[TD]1[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Hammer[/TD]
[TD]4[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Sam[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Nails[/TD]
[TD]25[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Bill[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Hammer[/TD]
[TD]9[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Fred[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Hammer[/TD]
[TD]1[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Nails[/TD]
[TD]24[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Wrench[/TD]
[TD]4[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

I don't know if what I asking is even possible, but I am stumped and wanted to get some outside help.

Thanks in advance for you time and consideration.

BWL

 

[Fluff]

Hi & welcome to the board
How about

Sub RearrangeData()

   Dim Dic As Object
   Dim Cl As Range
   Dim v1 As String, v2 As String
   Dim v3 As Long
   Dim Ky1 As Variant
   Dim Ws1 As Worksheet, Ws2 As Worksheet
   Dim NxtRw As Long
   
   Set Ws1 = Sheets("[COLOR=#ff0000]Upload[/COLOR]")
   Set Ws2 = Sheets("[COLOR=#ff0000]New[/COLOR]")
   Set Dic = CreateObject("scripting.dictionary")
   
   For Each Cl In Ws1.Range("A2", Ws1.Range("A" & Rows.Count).End(xlUp))
      v1 = Cl.Value: v2 = Cl.Offset(, 1).Value
      If Cl.Offset(, 2).Value = "Remove" Then v3 = -Cl.Offset(, 3).Value Else v3 = Cl.Offset(, 3).Value
      If Not Dic.exists(v1) Then
         Dic.Add v1, CreateObject("scripting.dictionary")
         Dic(v1).Add v2, v3
      ElseIf Not Dic(v1).exists(v2) Then
         Dic(v1).Add v2, v3
      Else
         Dic(v1)(v2) = Dic(v1)(v2) + v3
      End If
   Next Cl
   For Each Ky1 In Dic.keys
      NxtRw = Ws2.Range("B" & Rows.Count).End(xlUp).Offset(1).Row
      Ws2.Range("A" & NxtRw).Value = Ky1
      Ws2.Range("B" & NxtRw + 1).Resize(Dic(Ky1).Count).Value = Application.Transpose(Dic(Ky1).keys)
      Ws2.Range("C" & NxtRw + 1).Resize(Dic(Ky1).Count).Value = Application.Transpose(Dic(Ky1).items)
   Next Ky1
   
End Sub

Change sheet names in red to suit

 

[Sontauzo]

Holy Smokes! That was amazingly fast. Thank you SO much!!! This is exactly what i was looking for, and it works perfectly!

BWL

 

[Fluff]

Glad to help & thanks for the feedback