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