Help with Reformatting/Calculating spreadsheet

Sontauzo

New Member
Joined
Mar 13, 2018
Messages
18
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.


UserItemTransactionQuantity
TomHammerRemove1
TomNailsRemove40
TomNailsReturn7
MaryWrenchRemove2
MaryHammerRemove4
MaryWrenchReturn1
SamNailsRemove60
SamNailsReturn35
BillHammerRemove2
BillHammerRemove7
FredHammerRemove1
FredNailsRemove25
FredWrenchRemove4
FredNailsReturn1

<tbody>
</tbody>


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

UserItemQuantity
Tom
Hammer1
Nails33
Mary
Wrench1
Hammer4
Sam
Nails25
Bill
Hammer9
Fred
Hammer1
Nails24
Wrench4

<tbody>
</tbody>

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
 

Some videos you may like

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
46,530
Office Version
  1. 365
Platform
  1. Windows
Hi & welcome to the board
How about
Code:
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

New Member
Joined
Mar 13, 2018
Messages
18
Holy Smokes! That was amazingly fast. :) Thank you SO much!!! This is exactly what i was looking for, and it works perfectly!

BWL
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
46,530
Office Version
  1. 365
Platform
  1. Windows
Glad to help & thanks for the feedback
 

Watch MrExcel Video

Forum statistics

Threads
1,109,335
Messages
5,528,096
Members
409,802
Latest member
joeino

This Week's Hot Topics

  • Change military grades into rank
    Afternoon all Need help with formula that will change military rank (i.e. 1, 2, 3 into Amn, A1C, SrA). Running IF formula that does not work...
  • VBA COUNTIF SOLUTION
    Hi The following are the errors spread across the several columns from E to Q ie. 13 columns across several sheets with more than 500 rows per...
  • INSERT ROW WITH SPECIFIS TEXT IN A COLUMN
    Hi All! How can identify that that the row to be inserted has to be inserted before 1st row with specific text in column F. If I record the...
  • Auto-Create a monthly Sign in sheet for preschool students
    The image below is what each page looks like. Above is space for the "Child Name" "Month" "Class" School days are obviously Monday-Friday but...
  • VBA vlookup multiple results
    Hi folks, Hopefully someone out there can help. I have a list to vlookup which works (ish). the lookup only picks up the first instance of the...
  • Extract values for earliest/latest times
    I am trying to put together a formula to get the earliest start time, the latest end time from column A for each person in Column B-F without the...
Top