vba script for % price change over the period

Originally Posted by AlphaFrog

Sub DataTest_V4()
    Dim vT, v, vv, vMin, vMax
    Dim i As Long, d As Object
    Dim t 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)
        d.RemoveAll
        
        'Quantity Transactions
        For i = 2 To UBound(vT)
            d.Item(vT(i, 1)) = d.Item(vT(i, 1)) + vT(i, 4)
        Next i
        .Cells(2, 3).Resize(d.Count) = Application.Transpose(d.items)
        v = d.items
        d.RemoveAll
        
        'First Issue Date Transactions
        For i = 2 To UBound(vT)
            If IsEmpty(d(vT(i, 1))) Then
                d.Item(vT(i, 1)) = vT(i, 3)
            Else
                d.Item(vT(i, 1)) = WorksheetFunction.Min(d.Item(vT(i, 1)), vT(i, 3))
            End If
        Next i
        .Cells(2, 4).Resize(d.Count) = Application.Transpose(d.items)
        d.RemoveAll
        
        'Minimum Cost Transactions
        For i = 2 To UBound(vT)
            If IsEmpty(d(vT(i, 1))) Then
                d.Item(vT(i, 1)) = vT(i, 6)
            Else
                d.Item(vT(i, 1)) = WorksheetFunction.Min(d.Item(vT(i, 1)), vT(i, 6))
            End If
        Next i
        vMin = d.items
        .Cells(2, 5).Resize(d.Count) = Application.Transpose(d.items)
        d.RemoveAll
        
        'Maximum Cost Transactions
        For i = 2 To UBound(vT)
            If IsEmpty(d(vT(i, 1))) Then
                d.Item(vT(i, 1)) = vT(i, 6)
            Else
                d.Item(vT(i, 1)) = WorksheetFunction.Max(d.Item(vT(i, 1)), vT(i, 6))
            End If
        Next i
        vMax = d.items
        .Cells(2, 6).Resize(d.Count) = Application.Transpose(d.items)
        d.RemoveAll
        
        'Total Cost Transactions
        For i = 2 To UBound(vT)
            d.Item(vT(i, 1)) = d.Item(vT(i, 1)) + vT(i, 7)
        Next i
        vv = d.items
        d.RemoveAll
        
        'Average Cost Transactions
        For i = LBound(v) To UBound(v)
            If v(i) = 0 Then
                d.Item(i + 1) = 0
            Else
                d.Item(i + 1) = vv(i) / v(i)
            End If
        Next i
        .Cells(2, 7).Resize(d.Count) = Application.Transpose(d.items)
        d.RemoveAll
        
        'Percent Change
        For i = LBound(vMin) To UBound(vMin)
            If vMin(i) > 0 Then vMin(i) = (vMax(i) - vMin(i)) / vMin(i)
        Next i
        .Cells(2, 8).Resize(UBound(vMin) + 1) = Application.Transpose(vMin)
        
        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

Thanks AlphaFrog for replying. It is absolutely working fine where the prices have been increased over the time but it is not where the prices have been decreased, example, for item #23456789, the % change should be (21-32)/32 = -34% instead of 52.4%. Please refer in the attached.