vba to pull out information from multiple worksheets

A

abhi_jain80

New Member
Joined
May 31, 2021
Messages
27
Office Version
  1. 2016
Platform
  1. Windows
Hi experts,

I got the vba script which is pulling out the relevant information from the "Transactions" worksheet to the "Output" worksheet against the unique transactions "Item#". All these information are available in the "Transactions" worksheet. Now I have the "Item#" in another worksheet say "Purchases" and need to pull out the other information from the "Transactions" worksheet to the "Output" worksheet.
I am trying to modify the script accordingly but could not able to do it. Can anyone of you support me with this please...thanks in advance.
Hope I am clear with the need. Attaching the images for all 3 worksheets.

VBA Code: 
Sub DataTest()
    Dim vT, v
    Dim i As Long, ndx As Long, d As Object
    Dim t As Double, tc As Double, fic As Double
   
    t = Timer
    vT = Range("Transactions!A1").CurrentRegion.Value2
    Set d = CreateObject("Scripting.Dictionary")
   
    With Worksheets("Output")
        .Cells(1, 1).CurrentRegion.Offset(1).Clear
       
        'Item and Description Transactions
        For i = 2 To UBound(vT)
            d.Item(vT(i, 1)) = vT(i, 2)
        Next i
        .Cells(2, 1).Resize(d.Count) = Application.Transpose(d.keys)
        .Cells(2, 2).Resize(d.Count) = Application.Transpose(d.items)
       
        ReDim v(1 To d.Count, 1 To 6)
       
        For i = 2 To UBound(vT)
       
            ndx = Application.Match(vT(i, 1), d.keys, 0)
           
            If v(ndx, 2) = Empty Then
                v(ndx, 2) = vT(i, 3)            'First issue date
                v(ndx, 3) = vT(i, 6)            'Initial Cost
                fic = vT(i, 6)                  'First issue cost
                tc = 0
            End If
           
            v(ndx, 3) = Application.Min(v(ndx, 3), vT(i, 6))  'Min Cost
            v(ndx, 4) = Application.Max(v(ndx, 4), vT(i, 6))  'Max Cost
           
            v(ndx, 1) = v(ndx, 1) + vT(i, 4)    'Quantity
           
            tc = tc + vT(i, 7) 'running total cost to calculate avg cost
            If v(ndx, 1) <> 0 Then v(ndx, 5) = tc / v(ndx, 1) Else v(ndx, 5) = 0 'Average Cost
           
            If fic <> 0 Then v(ndx, 6) = (vT(i, 6) - fic) / fic 'Percent Change
           
        Next
       
        d.RemoveAll
       
        .Cells(2, 3).Resize(UBound(v, 1), UBound(v, 2)).Value = v
       
        With .UsedRange
            .Columns("A:B").NumberFormat = "@"
            .Columns("C").NumberFormat = "#,##0"
            .Columns("D").NumberFormat = "d/m/yyyy"
            .Columns("E:G").NumberFormat = "$* #,##0.00"
            .Columns("H").NumberFormat = "0.0%"
        End With
       
    End With
   
    MsgBox Timer - t
End Sub
 

Attachments

  • Output.PNG
    Output.PNG
    26.4 KB · Views: 14
  • Transactions.PNG
    Transactions.PNG
    17.5 KB · Views: 15
  • Purchases.PNG
    Purchases.PNG
    23.9 KB · Views: 15

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)
Sort by date Sort by votes
abhi_jain80 said:
. Now I have the "Item#" in another worksheet say "Purchases" and need to pull out the other information from the "Transactions" worksheet to the "Output" worksheet.
Click to expand...
You mean, take the data from the "Purchases" sheet and put it on the "Output" sheet.

Based on your example images, you could put what the final result would be on the "output" sheet.
But maybe you have to expand the example a bit, to know how to consolidate the data of the "purchase" sheet when there is more than one record with the same item#.
 
Upvote 0
DanteAmor said:
You mean, take the data from the "Purchases" sheet and put it on the "Output" sheet.

Based on your example images, you could put what the final result would be on the "output" sheet.
But maybe you have to expand the example a bit, to know how to consolidate the data of the "purchase" sheet when there is more than one record with the same item#.
Click to expand...

I mean that, take the unique Item# from the "Purchases" sheet and rest of the information from the "Transactions" sheet against those Item#. Currently the Item# along with the other records are from the "Transactions" sheet only.
The "Output" sheet should have the same info, the only difference in Item# which should be pulled from "Purchases" rather than "Transactions" sheet. Hope I am clear now, let me know if I am not. Thanks
 
Upvote 0
Just check that both the Purchase Item and the Transaction Item are texts.

Try this:

VBA Code: 
Sub DataTest()
  Dim vT As Variant, vP As Variant, v As Variant
  Dim i As Long, ndx As Long, d As Object, d2 As Object
  Dim t As Double, tc As Double, fic As Double
  
  t = Timer
  vP = Range("Purchases!A1").CurrentRegion.Value2
  vT = Range("Transactions!A1").CurrentRegion.Value2
  Set d = CreateObject("Scripting.Dictionary")
  Set d2 = CreateObject("Scripting.Dictionary")
  ReDim v(1 To UBound(vT), 1 To 8)
  
  'Unique Items from Purchase
  For i = 2 To UBound(vP)
    d2(vP(i, 3)) = Empty
  Next i
  
  For i = 2 To UBound(vT)
    'Read only the items that are in Purchase
    If d2.exists(vT(i, 1)) Then
      'Item and data from Transactions
      If Not d.exists(vT(i, 1)) Then
        ndx = ndx + 1
        d(vT(i, 1)) = ndx
        v(ndx, 1) = vT(i, 1)        'Item
        v(ndx, 2) = vT(i, 2)        'Description
        v(ndx, 4) = vT(i, 3)        'First issue date
        v(ndx, 5) = vT(i, 6)        'Initial Cost
        fic = vT(i, 6)              'First issue cost
        tc = 0
      Else
        ndx = d(vT(i, 1))
      End If
      
      v(ndx, 3) = v(ndx, 3) + vT(i, 4)    'Quantity
      v(ndx, 5) = Application.Min(v(ndx, 5), vT(i, 6))  'Min Cost
      v(ndx, 6) = Application.Max(v(ndx, 6), vT(i, 6))  'Max Cost
      
      tc = tc + vT(i, 7) 'running total cost to calculate avg cost
      If v(ndx, 3) <> 0 Then v(ndx, 7) = tc / v(ndx, 3) Else v(ndx, 7) = 0 'Average Cost
      If fic <> 0 Then v(ndx, 8) = (vT(i, 6) - fic) / fic 'Percent Change
    End If
  Next i
  
  With Worksheets("Output")
    .Cells(1, 1).CurrentRegion.Offset(1).Clear
    .Cells(2, 1).Resize(ndx, UBound(v, 2)).Value = v
    With .UsedRange
      .Columns("A:B").NumberFormat = "@"
      .Columns("C").NumberFormat = "#,##0"
      .Columns("D").NumberFormat = "d/m/yyyy"
      .Columns("E:G").NumberFormat = "$* #,##0.00"
      .Columns("H").NumberFormat = "0.0%"
    End With
  End With
  
  MsgBox Timer - t
End Sub
 
Upvote 0
DanteAmor said:
Just check that both the Purchase Item and the Transaction Item are texts.

Try this:

VBA Code: 
Sub DataTest()
  Dim vT As Variant, vP As Variant, v As Variant
  Dim i As Long, ndx As Long, d As Object, d2 As Object
  Dim t As Double, tc As Double, fic As Double
 
  t = Timer
  vP = Range("Purchases!A1").CurrentRegion.Value2
  vT = Range("Transactions!A1").CurrentRegion.Value2
  Set d = CreateObject("Scripting.Dictionary")
  Set d2 = CreateObject("Scripting.Dictionary")
  ReDim v(1 To UBound(vT), 1 To 8)
 
  'Unique Items from Purchase
  For i = 2 To UBound(vP)
    d2(vP(i, 3)) = Empty
  Next i
 
  For i = 2 To UBound(vT)
    'Read only the items that are in Purchase
    If d2.exists(vT(i, 1)) Then
      'Item and data from Transactions
      If Not d.exists(vT(i, 1)) Then
        ndx = ndx + 1
        d(vT(i, 1)) = ndx
        v(ndx, 1) = vT(i, 1)        'Item
        v(ndx, 2) = vT(i, 2)        'Description
        v(ndx, 4) = vT(i, 3)        'First issue date
        v(ndx, 5) = vT(i, 6)        'Initial Cost
        fic = vT(i, 6)              'First issue cost
        tc = 0
      Else
        ndx = d(vT(i, 1))
      End If
     
      v(ndx, 3) = v(ndx, 3) + vT(i, 4)    'Quantity
      v(ndx, 5) = Application.Min(v(ndx, 5), vT(i, 6))  'Min Cost
      v(ndx, 6) = Application.Max(v(ndx, 6), vT(i, 6))  'Max Cost
     
      tc = tc + vT(i, 7) 'running total cost to calculate avg cost
      If v(ndx, 3) <> 0 Then v(ndx, 7) = tc / v(ndx, 3) Else v(ndx, 7) = 0 'Average Cost
      If fic <> 0 Then v(ndx, 8) = (vT(i, 6) - fic) / fic 'Percent Change
    End If
  Next i
 
  With Worksheets("Output")
    .Cells(1, 1).CurrentRegion.Offset(1).Clear
    .Cells(2, 1).Resize(ndx, UBound(v, 2)).Value = v
    With .UsedRange
      .Columns("A:B").NumberFormat = "@"
      .Columns("C").NumberFormat = "#,##0"
      .Columns("D").NumberFormat = "d/m/yyyy"
      .Columns("E:G").NumberFormat = "$* #,##0.00"
      .Columns("H").NumberFormat = "0.0%"
    End With
  End With
 
  MsgBox Timer - t
End Sub
Click to expand...

Thanks DanteAmor. This is absolutely working fine. The only thing...I want to read all the items from "Purchases". If there are no records in "Transactions" against any item, the respective fields should be blank. can you please modify the script accordingly? Thanks.
 
Upvote 0
Try this:

VBA Code: 
Sub DataTest()
  Dim vT As Variant, vP As Variant, v As Variant, ky As Variant
  Dim i As Long, ndx As Long, d As Object, d2 As Object
  Dim t As Double, tc As Double, fic As Double
  
  t = Timer
  vP = Range("Purchases!A1").CurrentRegion.Value2
  vT = Range("Transactions!A1").CurrentRegion.Value2
  Set d = CreateObject("Scripting.Dictionary")
  Set d2 = CreateObject("Scripting.Dictionary")
  ReDim v(1 To UBound(vP), 1 To 8)
  
  'Unique Items from Purchase
  For i = 2 To UBound(vP)
    d2(vP(i, 3)) = vP(i, 4)
  Next i
  
  'Unique Items from Transactions
  For i = 2 To UBound(vT)
    d(vT(i, 1)) = Empty
  Next i
  
  'd.RemoveAll
  For Each ky In d2.keys
    If d.exists(ky) Then
      For i = 2 To UBound(vT)
        'Read only the items that are in Purchase
        If vT(i, 1) = ky Then
          'Item and data from Transactions
          If d(vT(i, 1)) = Empty Then
            ndx = ndx + 1
            d(vT(i, 1)) = ndx
            v(ndx, 1) = vT(i, 1)        'Item
            v(ndx, 2) = vT(i, 2)        'Description
            v(ndx, 4) = vT(i, 3)        'First issue date
            v(ndx, 5) = vT(i, 6)        'Initial Cost
            fic = vT(i, 6)              'First issue cost
            tc = 0
          Else
            ndx = d(vT(i, 1))
          End If
          
          v(ndx, 3) = v(ndx, 3) + vT(i, 4)    'Quantity
          v(ndx, 5) = Application.Min(v(ndx, 5), vT(i, 6))  'Min Cost
          v(ndx, 6) = Application.Max(v(ndx, 6), vT(i, 6))  'Max Cost
          
          tc = tc + vT(i, 7) 'running total cost to calculate avg cost
          If v(ndx, 3) <> 0 Then v(ndx, 7) = tc / v(ndx, 3) Else v(ndx, 7) = 0 'Average Cost
          If fic <> 0 Then v(ndx, 8) = (vT(i, 6) - fic) / fic 'Percent Change
        End If
      Next i
    Else
      ndx = ndx + 1
      v(ndx, 1) = ky            'Item
      v(ndx, 2) = d2(ky)        'Description
    End If
  Next ky
  
  With Worksheets("Output")
    .Cells(1, 1).CurrentRegion.Offset(1).Clear
    .Cells(2, 1).Resize(ndx, UBound(v, 2)).Value = v
    With .UsedRange
      .Columns("A:B").NumberFormat = "@"
      .Columns("C").NumberFormat = "#,##0"
      .Columns("D").NumberFormat = "d/m/yyyy"
      .Columns("E:G").NumberFormat = "$* #,##0.00"
      .Columns("H").NumberFormat = "0.0%"
    End With
  End With
  
  MsgBox Timer - t
End Sub
 
Upvote 0
Solution
DanteAmor said:
Try this:

VBA Code: 
Sub DataTest()
  Dim vT As Variant, vP As Variant, v As Variant, ky As Variant
  Dim i As Long, ndx As Long, d As Object, d2 As Object
  Dim t As Double, tc As Double, fic As Double
 
  t = Timer
  vP = Range("Purchases!A1").CurrentRegion.Value2
  vT = Range("Transactions!A1").CurrentRegion.Value2
  Set d = CreateObject("Scripting.Dictionary")
  Set d2 = CreateObject("Scripting.Dictionary")
  ReDim v(1 To UBound(vP), 1 To 8)
 
  'Unique Items from Purchase
  For i = 2 To UBound(vP)
    d2(vP(i, 3)) = vP(i, 4)
  Next i
 
  'Unique Items from Transactions
  For i = 2 To UBound(vT)
    d(vT(i, 1)) = Empty
  Next i
 
  'd.RemoveAll
  For Each ky In d2.keys
    If d.exists(ky) Then
      For i = 2 To UBound(vT)
        'Read only the items that are in Purchase
        If vT(i, 1) = ky Then
          'Item and data from Transactions
          If d(vT(i, 1)) = Empty Then
            ndx = ndx + 1
            d(vT(i, 1)) = ndx
            v(ndx, 1) = vT(i, 1)        'Item
            v(ndx, 2) = vT(i, 2)        'Description
            v(ndx, 4) = vT(i, 3)        'First issue date
            v(ndx, 5) = vT(i, 6)        'Initial Cost
            fic = vT(i, 6)              'First issue cost
            tc = 0
          Else
            ndx = d(vT(i, 1))
          End If
         
          v(ndx, 3) = v(ndx, 3) + vT(i, 4)    'Quantity
          v(ndx, 5) = Application.Min(v(ndx, 5), vT(i, 6))  'Min Cost
          v(ndx, 6) = Application.Max(v(ndx, 6), vT(i, 6))  'Max Cost
         
          tc = tc + vT(i, 7) 'running total cost to calculate avg cost
          If v(ndx, 3) <> 0 Then v(ndx, 7) = tc / v(ndx, 3) Else v(ndx, 7) = 0 'Average Cost
          If fic <> 0 Then v(ndx, 8) = (vT(i, 6) - fic) / fic 'Percent Change
        End If
      Next i
    Else
      ndx = ndx + 1
      v(ndx, 1) = ky            'Item
      v(ndx, 2) = d2(ky)        'Description
    End If
  Next ky
 
  With Worksheets("Output")
    .Cells(1, 1).CurrentRegion.Offset(1).Clear
    .Cells(2, 1).Resize(ndx, UBound(v, 2)).Value = v
    With .UsedRange
      .Columns("A:B").NumberFormat = "@"
      .Columns("C").NumberFormat = "#,##0"
      .Columns("D").NumberFormat = "d/m/yyyy"
      .Columns("E:G").NumberFormat = "$* #,##0.00"
      .Columns("H").NumberFormat = "0.0%"
    End With
  End With
 
  MsgBox Timer - t
End Sub
Click to expand...
Great...Thanks a million. This works for me.
 
Upvote 0
Hi DanteAmor,

Sorry to come back to you again on the same query.

Actually I have added 2 more columns in the "Output" sheet as "Qty Ordered" and "Bin Qty". "Qty Ordered" should come from "Purchases" sheet ('Qty' column2) and "Bin Qty" should come from newly added "Inventory" sheet ('Bin Qty' column), image uploaded.

I have added few more lines in your code accordingly which is partially working fine. I am getting the details in these 2 new columns only for those items which are in "Transactions" sheet and not for all the items. Just wondering what I am missing?? Thought I would do but not been able to :( . can you please look into this also?....thanks

VBA Code: 
Sub DataTest()
  Dim vT As Variant, vP As Variant, v As Variant, ky As Variant, vI As Variant
  Dim i As Long, ndx As Long, d As Object, d2 As Object
  Dim t As Double, tc As Double, fic As Double
  
  t = Timer
  vP = Range("Purchases!A1").CurrentRegion.Value2
  vT = Range("Transactions!A1").CurrentRegion.Value2
  vI = Range("Inventory!A1").CurrentRegion.Value2
  
  Set d = CreateObject("Scripting.Dictionary")
  Set d2 = CreateObject("Scripting.Dictionary")
  ReDim v(1 To UBound(vP), 1 To 10)
  
  'Unique Items from Purchase
  For i = 2 To UBound(vP)
    d2(vP(i, 3)) = vP(i, 4)
  Next i
  
  'Unique Items from Transactions
  For i = 2 To UBound(vT)
    d(vT(i, 1)) = Empty
  Next i
  
  'd.RemoveAll
  For Each ky In d2.keys
    If d.exists(ky) Then
      For i = 2 To UBound(vT)
        'Read only the items that are in Purchase
        If vT(i, 1) = ky Then
          'Item and data from Transactions
          If d(vT(i, 1)) = Empty Then
            ndx = ndx + 1
            d(vT(i, 1)) = ndx
            v(ndx, 1) = vT(i, 1)        'Item
            v(ndx, 2) = vT(i, 2)        'Description
            v(ndx, 4) = vT(i, 3)        'First issue date
            v(ndx, 5) = vT(i, 6)        'Initial Cost
            fic = vT(i, 6)              'First issue cost
            tc = 0
          Else
            ndx = d(vT(i, 1))
          End If
          
          v(ndx, 3) = v(ndx, 3) + vT(i, 4)    'Quantity
          v(ndx, 5) = Application.Min(v(ndx, 5), vT(i, 6))  'Min Cost
          v(ndx, 6) = Application.Max(v(ndx, 6), vT(i, 6))  'Max Cost
          
          tc = tc + vT(i, 7) 'running total cost to calculate avg cost
          If v(ndx, 3) <> 0 Then v(ndx, 7) = tc / v(ndx, 3) Else v(ndx, 7) = 0 'Average Cost
          If fic <> 0 Then v(ndx, 8) = (vT(i, 6) - fic) / fic 'Percent Change
        End If
      Next i
    Else
      ndx = ndx + 1
      v(ndx, 1) = ky            'Item
      v(ndx, 2) = d2(ky)        'Description
    End If
  Next ky

''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''
 'Pull data from purchases
  For Each ky In d2.keys
    If d.exists(ky) Then
      For i = 2 To UBound(vP)
        'Read only the items that are in Purchase
        If vP(i, 3) = ky Then
          'Item and data from Transactions
          If d(vP(i, 3)) = Empty Then
            ndx = ndx + 1
            d(vP(i, 3)) = ndx
          Else
            ndx = d(vP(i, 3))
          End If
          v(ndx, 9) = v(ndx, 9) + vP(i, 2)    'Qty Ordered
        End If
      Next i
    Else
      ndx = ndx + 1
    End If
  Next ky

  'Pull data from inventory
  For Each ky In d2.keys
    If d.exists(ky) Then
      For i = 2 To UBound(vI)
        'Read only the items that are in Purchase
        If vI(i, 1) = ky Then
          'Item and data from Transactions
          If d(vI(i, 1)) = Empty Then
            ndx = ndx + 1
            d(vI(i, 1)) = ndx
          Else
            ndx = d(vI(i, 1))
          End If
          v(ndx, 10) = v(ndx, 10) + vI(i, 3)    'Bin Qty
        End If
      Next i
    Else
      ndx = ndx + 1
    End If
  Next ky

''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''

  With Worksheets("Output")
    .Cells(1, 1).CurrentRegion.Offset(1).Clear
    .Cells(2, 1).Resize(ndx, UBound(v, 2)).Value = v
    With .UsedRange
      .Columns("A:B").NumberFormat = "@"
      .Columns("C").NumberFormat = "#,##0"
      .Columns("D").NumberFormat = "d/m/yyyy"
      .Columns("E:G").NumberFormat = "$* #,##0.00"
      .Columns("H").NumberFormat = "0.0%"
    End With
  End With
  
  MsgBox Timer - t
End Sub
 

Attachments

  • Inventory.PNG
    Inventory.PNG
    18.7 KB · Views: 7
Upvote 0
abhi_jain80 said:
I am getting the details in these 2 new columns only for those items which are in "Transactions" sheet and not for all the items.
Click to expand...
Dictionary d2 only contains items from sheet "purchase", if an item from sheet "transactions" is not in sheet "purchase" then you will not be able to read the information of that item through dictionary d2.

I guess you would have to loop through the items in the "transactions" sheet and the ones that are not in the "purchase" sheet add them to the "output" sheet.
 
Upvote 0
You must log in or register to reply here.

Similar threads

N
  • Question Question
VBA Transpose & Join Help
Replies
5
Views
332
Alex Blakenburg
A
G
  • Question Question
remove columns from multiple Excel-files in a folder
Replies
5
Views
213
gjvv
G
P
  • Question Question
putting a snippet of code from one to another somehow
Replies
5
Views
304
Patriot2879
P
J
  • Question Question
Complex Move data from two spreadsheets with similar data in different columns to a specific column in an existing spreadsheet(Sheet 3)
Replies
0
Views
339
JMC57
J
G
  • Solved
Combine input box (multiple criteria)
Replies
4
Views
107
gomes123
G

Forum statistics

Threads
1,223,919
Messages
6,175,368
Members
452,638
Latest member
Oluwabukunmi

Share this page

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