Create summary list using VBA... (pivot table style)

bilton78

New Member
Joined
Jul 5, 2007
Messages
6
I'd like to generate a summary from columns of data. Normally I'd use a pivot table but I need to automate this using VBA. Basically there is a new entry for every time someone uses a tool and how long the tool is used for. What I need to do is summarize the total time that each person spent with each type of tool.


My data table is laid out as such:

Column A - Names (that can be repeated)
Column B - Tool (can be repeated)
Column C - Time

What I would like to see is VBA creating a new "summary" table using data from the input table similar to the functionality of a pivot table. I've found some code that will allow me to put a list of unique names from column A in a list so I need to expand that to include the tools that were used. After I generate that list, I can use an array formula (unless there's a better suggestion) to calculate the time used with each tool.

Here's the code I have so far. Any additional help would be greatly appreciated.

Sub UniqueList()
Dim rListPaste As Range

On Error Resume Next

Set rListPaste = Range("H1")

Range("A1", Range("A65536").End(xlUp)).AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:=rListPaste.Cells(1, 1), Unique:=True

End Sub

Thanks!
 

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand
try
Code:
Sub test()
Dim a, b(), i As Long, n As Long, t As Long
Dim dic1 As Object, dic2 As Object
Set dic1 = CreateObject("Scripting.Dictionary")
dic1.CompareMode = vbTextCompare
Set dic2 = CreateObject("Scripting.Dictionary")
dic2.CompareMode = vbTextCompare
With Range("a1").CurrentRegion.Resize(, 3)
    a = .Value
    ReDim b(1 To UBound(a, 1), 1 To UBound(a, 1))
    b(1, 1) = Name : n = 1 : t = 1
    For i = 2 To UBound(a, 1)
        If Not dic1.exists(a(i, 1)) Then
            n = n + 1 : b(n, 1) = a(i, 1)
            dic1.add a(i, 1), n
        End If
        If Not dic2.exists(a(i, 2)) Then
            t = t + 1 : b(1, t) = a(i, 2)
            dic2.add a(i, 2), t
        End If
        b(dic1(a(i, 1)), dic2(a(i, 2))) = b(dic1(a(i, 1)), dic2(a(i, 2))) + a(i, 3)
    Next
    With .Resize(1, 1).Offset(, .Columns.Count + 1)
        .CurrentRegion.ClearContents
        .Resize(n, t).Value = b
    End With
End With
Set dic1 = Nothing : set dic2 = Nothing
End sub
 
Upvote 0

Forum statistics

Threads
1,213,501
Messages
6,114,010
Members
448,543
Latest member
MartinLarkin

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