vba code - build logic around percentage change calculations

abhi_jain80

New Member
Hi folks,

An expert helped me out with the below code which is pulling out the information from "transactions" and "purchases" worksheets to the "output" worksheet.

I need to build-in one more logic - to exclude all the rows from the "perc change" calculations (column H, "output" sheet) where the index number is 1 in column H, "transactions" sheet. I tried a lot to modify the code accordingly but failed to do so. Can anyone help me out please? Attaching the mini-sheets for your reference. Many thanks in advance....

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``````

sample data .xlsb
ABCDEFGH
1Item #DescriptionQty IssuedFirst Issue DateMin CostMax CostAvg CostPerc Change
220800030BOUFFANT CAP, PP728SBU000500BZ BOUFFANT CAP3289/1/2019£ 37.18£ 40.00£ 37.277.6%
323456789filter dpf61/1/2019£ 0.00£ 32.00£ 18.86-34.4%
410000076FILTER REGULATORAW4000-04CG Z19 XF36272/2/2019£ 0.37£ 40.00£ 1.12-99.0%
521600008MRO300 OIL DRY PAD 1 box qty. of 100294,2304/2/2019£ 0.00£ 40.00£ 0.37-99.0%
610000079CYL MGQL25-B7163-205244/2/2019£ 0.00£ 37.18£ 0.86-99.0%
710000080@ CYL. GUIDED 508CL MGQM25-B4827-17038512/4/2019£ 0.37£ 55.85£ 0.81-99.0%
810000081ACTUATOR ROTARY SMC11-CDRA1BS50-90C A53L1,2677/2/2019£ 0.37£ 56.00£ 0.68-99.0%
910000086CDBM2L25H-D7362-30 503CL48/2/2019£ 37.18£ 37.18£ 37.180.0%
Output

sample data .xlsb
ABCDEFGH
1Item #DescriptionTransaction DateQtyType Cost Total Cost Index Number
212345678TWEEZERS, WHITE PLASTIC 5"13/01/202020ISSUE\$ -\$ -1
312345678TWEEZERS, WHITE PLASTIC 5"18/02/2020100ISSUE\$ 2.14\$ 213.532
412345678TWEEZERS, WHITE PLASTIC 5"22/08/202020ISSUE\$ 3.00\$ 60.002
512345678TWEEZERS, WHITE PLASTIC 5"09/09/2020199ISSUE\$ 4.00\$ 796.002
623456789filter dpf01/01/20191ISSUE\$ 32.00\$ 32.002
723456789filter dpf06/01/20192ISSUE\$ -\$ -1
823456789filter dpf31/01/20191ISSUE\$ 23.00\$ 23.002
923456789filter dpf07/02/20191ISSUE\$ 21.00\$ 21.002
1023456789filter dpf07/02/20191ISSUE\$ -\$ -1
Transactions

sample data .xlsb
ABCDE
219/02/20201020800030BOUFFANT CAP, PP728SBU000500BZ BOUFFANT CAP21/05/2020
319/02/20202020800030BOUFFANT CAP, PP728SBU000500BZ BOUFFANT CAP04/03/2020
419/02/20202023456789filter dpf26/02/2020
519/02/20205820800030BOUFFANT CAP, PP728SBU000500BZ BOUFFANT CAP21/02/2020
619/02/20207220800030BOUFFANT CAP, PP728SBU000500BZ BOUFFANT CAP
704/02/20203310000076FILTER REGULATORAW4000-04CG Z19 XF313/02/2020
Purchases

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).

Replies
14
Views
285
Replies
1
Views
100
Replies
14
Views
6K
Replies
3
Views
649
Replies
1
Views
599

1,141,613
Messages
5,707,394
Members
421,508
Latest member
Jalayne

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.

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

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