abhi_jain80
New Member
- Joined
- May 31, 2021
- Messages
- 27
- Office Version
- 2016
- Platform
- 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.
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
