How to mimic a pivot table without a pivot table?

[nutra]

I have a list of items and their associated quantities, many items appearing multiple times. I need a concise list that summarizes each item and sums all of its quantities.

The obvious solution is a pivot table. However, I update this list frequently and for some reason the pivot table is difficult to update. is there a function or simple vba code that I could put into this workbook that would work better than my unflexible pivot table?

Thanks.

 

[Norie]

How is the pivot table difficult to update?

Can't you just right click it and select Refresh...?

If the problem is that your data is expanding/contracting then you could look at using a dynamic named range for the source of the pivot table.

I suppose you could mimic the pivot table with code but I'm pretty sure it wouldn't be too simple.

 

[Legacy 14611]

Items in column A, quantities in column B. No headers used although these easily included if need.
Code gives summary in columns E and F

Sub summarie()
Dim z As Object, e As Range
With Cells(1).CurrentRegion
Set z = CreateObject("Scripting.Dictionary")
For Each e In .Resize(, 1)
    z.Item(e.Value) = z.Item(e.Value) + e.Offset(, 1)
Next
.Offset(, 4).Resize(z.Count, 2) = Application.Transpose(Array(z.keys, z.items))
End With
End Sub

 

[northwolves]

With less data,"Consolidate" method of range is an option:

Sub summarie()
[e1].Consolidate "r1c1:r" & [b65536].End(3).Row & "c2", xlSum, 0, 1
End Sub

 

[northwolves]

Items in column A, quantities in column B. No headers used although these easily included if need.
Code gives summary in columns E and F

Sub summarie()
Dim z As Object, e As Range
With Cells(1).CurrentRegion
Set z = CreateObject("Scripting.Dictionary")
For Each e In .Resize(, 1)
    z.Item(e.Value) = z.Item(e.Value) + e.Offset(, 1)
Next
.Offset(, 4).Resize(z.Count, 2) = Application.Transpose(Array(z.keys, z.items))
End With
End Sub

Avoid using "Range" object when rows is more then 10k
Compare the following 2 subroutines:

Sub summarie()
Dim z As Object, e As Range, t As Single
t = Timer
[e:f] = ""
With Cells(1).CurrentRegion
Set z = CreateObject("Scripting.Dictionary")
For Each e In .Resize(, 1)
    z.Item(e.Value) = z.Item(e.Value) + e.Offset(, 1)
Next
.Offset(, 4).Resize(z.Count, 2) = Application.Transpose(Array(z.keys, z.items))
End With
MsgBox Timer - t & " seconds"
End Sub

Sub summarie2()
Dim z As Object, arr, n As Long, t As Single
t = Timer
[h:i] = ""
arr = [a1].CurrentRegion
Set z = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(arr)
z(arr(i, 1)) = z(arr(i, 1)) + arr(i, 2)
Next
n = z.Count
[h1].Resize(n, 2) = Application.Transpose(Array(z.keys, z.items))
MsgBox Timer - t & " seconds"
End Sub

 

[Legacy 14611]

Avoid using "Range" object when rows is more then 10k
Compare the following 2 subroutines:

hmm. The macro you quote was written solely to show it's easy to write a macro to mimic a pivot table.

It's always been clear enuf that working with arrays read off worksheet into memory is faster than a cell-by-cell approach, and of course I'm most happy that you re-demonstrate this.

I did a compare as you suggested using the following test data

Sub testdatagen()
ActiveSheet.UsedRange.ClearContents
n = 65000
[a1] = "A": [B1] = "B"
With [a2].Resize(n, 2)
    .Value = "=int(rand()* " & n & ")+1"
    .Value = .Value
End With
End Sub

The compare was actually with your code which doesn't really mimic a pivot table in that your results are not sorted, with the following code where the results do mimic a pivot table

Sub mimicpiv()
Application.ScreenUpdating = 0
Dim n&, b(), c, a, p&, i&, u&, t As Single
t = Timer
n = [a65536].End(xlUp).Row
ReDim b(1 To n, 1 To 2)
c = [a1].Resize(n, 2)
[a1].Resize(n, 2).Sort [a1], 1, header:=xlYes
a = Cells(1).Resize(n + 1, 2)
For i = 1 To n
    If Not a(i, 1) = a(i + 1, 1) Then
        p = p + 1
        b(p, 1) = a(i, 1)
        For j = 1 To i - u: b(p, 2) = b(p, 2) + a(u + j, 2): Next j
        u = i
    End If
Next i
[d1].Resize(p, 2) = b
'[a1].Resize(n, 2) = c
Application.ScreenUpdating = 1
MsgBox Format(Timer - t, "0.000")
End Sub

Maybe you should make Tom Urtis happy and throw away your scripting dictionary.

 

[northwolves]

hmm. The macro you quote was written solely to show it's easy to write a macro to mimic a pivot table.

It's always been clear enuf that working with arrays read off worksheet into memory is faster than a cell-by-cell approach, and of course I'm most happy that you re-demonstrate this.

I did a compare as you suggested using the following test data

Sub testdatagen()
ActiveSheet.UsedRange.ClearContents
n = 65000
[a1] = "A": [B1] = "B"
With [a2].Resize(n, 2)
    .Value = "=int(rand()* " & n & ")+1"
    .Value = .Value
End With
End Sub

The compare was actually with your code which doesn't really mimic a pivot table in that your results are not sorted, with the following code where the results do mimic a pivot table

Sub mimicpiv()
Application.ScreenUpdating = 0
Dim n&, b(), c, a, p&, i&, u&, t As Single
t = Timer
n = [a65536].End(xlUp).Row
ReDim b(1 To n, 1 To 2)
c = [a1].Resize(n, 2)
[a1].Resize(n, 2).Sort [a1], 1, header:=xlYes
a = Cells(1).Resize(n + 1, 2)
For i = 1 To n
    If Not a(i, 1) = a(i + 1, 1) Then
        p = p + 1
        b(p, 1) = a(i, 1)
        For j = 1 To i - u: b(p, 2) = b(p, 2) + a(u + j, 2): Next j
        u = i
    End If
Next i
[d1].Resize(p, 2) = b
'[a1].Resize(n, 2) = c
Application.ScreenUpdating = 1
MsgBox Format(Timer - t, "0.000")
End Sub

Maybe you should make Tom Urtis happy and throw away your scripting dictionary.

With this example,an array without dictionary is enough:

Sub mimicpiv2()
Application.ScreenUpdating = 0
Dim a, b(1 To 65536), c(65535, 1 To 2), i As Long, n As Long, t As Single
t = Timer
a = [a1].CurrentRegion
c(0, 1) = a(1, 1): c(0, 2) = a(1, 2)
For i = 2 To UBound(a)
b(a(i, 1)) = b(a(i, 1)) + a(i, 2)
Next
For i = 1 To 65536
If Len(b(i)) Then n = n + 1: c(n, 1) = i: c(n, 2) = b(i)
Next
[j1].Resize(n + 1, 2) = c
Application.ScreenUpdating = 1
MsgBox Format(Timer - t, "0.000")
End Sub

 

[Legacy 14611]

With this example,an array without dictionary is enough:

Sub mimicpiv2()
Application.ScreenUpdating = 0
Dim a, b(1 To 65536), c(65535, 1 To 2), i As Long, n As Long, t As Single
t = Timer
a = [a1].CurrentRegion
c(0, 1) = a(1, 1): c(0, 2) = a(1, 2)
For i = 2 To UBound(a)
b(a(i, 1)) = b(a(i, 1)) + a(i, 2)
Next
For i = 1 To 65536
If Len(b(i)) Then n = n + 1: c(n, 1) = i: c(n, 2) = b(i)
Next
[j1].Resize(n + 1, 2) = c
Application.ScreenUpdating = 1
MsgBox Format(Timer - t, "0.000")
End Sub

It doesn't seem enough.

Try it on the test test data

Sub testdatagen()
ActiveSheet.UsedRange.ClearContents
n = 10
[a1] = "A": [B1] = "B"
With [a2].Resize(n, 2)
    .Value = "=int(rand()* " & n & ")-3"
    .Value = .Value
End With
End Sub

and maybe report your results?

The aim of this thread as I understand was to mimic a pivot table using code.

 

[Norie]

Isn't this sort of like re-inventing the wheel?

I know it's possible but why use code when with a few clicks of the mouse, menu selections and a bit of tweaking you can get the same result.

 

[Legacy 14611]

Isn't this sort of like re-inventing the wheel?

I know it's possible but why use code when with a few clicks of the mouse, menu selections and a bit of tweaking you can get the same result.

Everyone to their own choice, but with one click of a mouse you can get the same result up to about 50 or more times faster on execution time alone, never mind the additional time and possibility of user error etc taken up by "a few clicks of a mouse, menu selections and a bit of tweaking".

Some of the problem sizes generated by the test data codes the Pivot Table (at least my 2003 version) can't handle at all and gives errors, while the codes given above handle them so very quickly and easily, and could do the same with much larger problems.

It's not re-inventing the wheel, it's just giving Excel users more options for tools from which to choose when addressing their many and diverse problems.

Consider a problem of 1000 rows of data for which you'd use, or recommend others to use, the Excel Pivot Table. What would you do with a problem of a million rows?