How to mimic a pivot table without a pivot table?

N

nutra

New Member
Joined
May 23, 2005
Messages
35
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.
 

Excel Facts

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"
Sort by date Sort by votes
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.:)
 
Upvote 0
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
Code: 
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
 
Upvote 0
With less data,"Consolidate" method of range is an option:
Code: 
Sub summarie()
[e1].Consolidate "r1c1:r" & [b65536].End(3).Row & "c2", xlSum, 0, 1
End Sub
 
Upvote 0
rugila said:
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
Code: 
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
Click to expand...

Avoid using "Range" object when rows is more then 10k
Compare the following 2 subroutines:
Code: 
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
 
Upvote 0
northwolves said:
Avoid using "Range" object when rows is more then 10k
Compare the following 2 subroutines:
Click to expand...
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
Code: 
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
Code: 
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.
 
Upvote 0
rugila said:
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
Code: 
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
Code: 
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.
Click to expand...

With this example,an array without dictionary is enough:
Code: 
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
 
Upvote 0
northwolves said:
With this example,an array without dictionary is enough:
Code: 
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
Click to expand...
It doesn't seem enough.

Try it on the test test data
Code: 
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.
 
Upvote 0
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.:)
 
Upvote 0
Norie said:
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.:)
Click to expand...
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?
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question Question
How can I copy the grouping rules from one pivot table to another pivot table?
Replies
0
Views
253
jaza_tom
J
trishcollins
  • Question Question
Private Worksheet Pivot table Update is affecting Pivot table on another worksheet which uses same data source
Replies
0
Views
462
trishcollins
trishcollins
M
  • Question Question
Excel pivot table query - retaining filters on pivot in absence of data
2
Replies
10
Views
3K
Alex Blakenburg
A
L
  • Question Question
Creating macro for nested calculations within calculations
Replies
2
Views
106
LizN
L
A
  • Question Question
Two dimensional dynamic named range over a pivot table not working as I thought
Replies
4
Views
862
ashleighbrown
A

Forum statistics

Threads
1,223,275
Messages
6,171,126
Members
452,381
Latest member
Nova88

Share this page

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