xkcd.com

xkcd.com
From the excellent blog: http://xkcd.com

Thursday 18 November 2010

Improve your Excel Pivot Table to count unique values or items

Short Version:
Updated in November 12,  faster execution.
A macro to allow a dynamic unique/distinct count field within your pivot table.
Copy the code, paste it in the right place, just renaming what you want to count.
Refresh the pivot: Done.

No intervention on source data required, factors pivot fields disposition and filters into the count.

I tried to anticipate most of the treacherous actions that treacherous users like you or me could try, to make it as adaptable as possible.

 Unimaginative preview of unique customers buying stuff:

 
Restrictions :
-English Excel 2007 or Excel 2010 only (the macro converts the data source into table format)
-No filter on invisible fields
-Save your file with xlsm extension.
-If you reopen your file, you may have an alert message, click OK, refresh the pivot table.

Also:
-No grouping of values
-Data must be within the workbook (no remote connection to database)
These two restrictions and slow performance can be avoided with the pivot compressor: http://lazyvba.blogspot.co.uk/2012/08/little-big-pivot.html

That’s it, I think.

Installation :
-Create your Pivot Table (only one please)
-Open Visual Basic Editor (Alt+F11)
-Paste the code in the sheet module where is your pivot table (use the tab name) and nowhere else.
-Edit the row « tocount = "name of the field" » and replace name by the field name you want to count
-Come back to Excel
-Do a refresh or a modification on the Pivot : Unik is appearing : that’s the count of unique items!
-Any modification recalculates Unik :  Just play with your pivot
-If your’re bored of it, hiding the Unik field stops the code. Put it back in the pivot, it’s counting again.

My comments :
-Totals are false (sum of unique count), but not visible (except collapsed items )
-If nothing happens, events may be disabled : just run the private sub boom at the beginning
-The method is not the most elegant, but I found it to be the fastest
-Code is not commented yet, and so not easily readable, please forgive me

Enjoy and let me know your comments.


The thing:

Private Sub boom()
Application.EnableEvents = True
End Sub

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
'by lazyvba.blogspot.com
Dim tocount As String

tocount = "name of the field"

Application.EnableEvents = False

Dim wb As Workbook, ws As Worksheet, wd As Worksheet, wp As Worksheet, pt As PivotTable, pf As PivotField _
, pi As PivotItem, str As String, str2 As String, Kode As String, totr As String, totc As String, rng As Range _
, li As ListObject, lo As ListObject, loc As ListColumn, rng1 As Range, rng2 As Range, t As Integer
Dim rf As Integer

Set wb = ActiveWorkbook
Set wp = ActiveSheet
Set pt = wp.PivotTables(1)
pt.Name = "PT"
t = 0
For Each ws In wb.Worksheets
For Each li In ws.ListObjects
If li.Name = pt.SourceData Then
li.Name = "Datas"
Set lo = li
t = 1
End If
Next li
Next ws

If t = 0 Then
For Each ws In wb.Worksheets
On Error Resume Next
Set wd = ws.Range(Application.ConvertFormula(pt.SourceData _
, fromreferencestyle:=xlR1C1, toreferencestyle:=xlA1)).Parent
On Error GoTo 0
Next ws

If wd.ListObjects.Count = 0 Then
wd.ListObjects.Add(xlSrcRange, wd.Range(Application.ConvertFormula _
(pt.SourceData, fromreferencestyle:=xlR1C1, toreferencestyle:=xlA1 _
)), , xlYes).Name = "Datas"
Else
wd.ListObjects(1).Name = "Datas"
End If
Set lo = wd.ListObjects("Datas")
End If

t = 0
For Each pf In pt.PivotFields
If pf.Name = "Unik" Then t = 1
Next pf
If t = 1 Then GoTo testunik

Setup:
lo.ListColumns.Add
lo.ListColumns(lo.ListColumns.Count).Name = "Visi"
lo.ListColumns.Add
lo.ListColumns(lo.ListColumns.Count).Name = "Kode"
lo.ListColumns.Add
lo.ListColumns(lo.ListColumns.Count).Name = "Unik"

With pt
  .ChangePivotCache ActiveWorkbook.PivotCaches. _
        Create(SourceType:=xlDatabase, SourceData:="Datas", Version:= _
        xlPivotTableVersion12)
   .PivotCache.Refresh
.InGridDropZones = True
.RowAxisLayout xlTabularRow
End With

With pt.PivotFields("Unik")
.Orientation = 4
  .Caption = " Unik"
        .Function = xlSum
End With

testunik:
t = 0
For Each pf In pt.DataFields
If InStrB(pf.Name, "Unik") > 0 Then
t = 1
If pf.Name <> " Unik" Then
With pf
.Caption = " Unik"
.Function = xlSum
End With
End If
End If
Next pf
If t = 0 Then
Application.EnableEvents = True
Exit Sub
End If

Kode = ""
With pt
For Each pf In pt.PageFields
If pf.AllItemsVisible = False Then
    For Each pi In pf.PivotItems
    If pi.Visible = False Then
        If Kode = "" Then
        Kode = "[" & pf.Name & "]" & "<>" & """" & pi.Name & """"
        Else
        Kode = Kode & "," & "[" & pf.Name & "]" & "<>" & """" & pi.Name & """"
        End If
    End If
    Next pi
End If
Next pf
End With

If Kode = "" Then
Kode = 1
Else
Kode = "=IF(and(" & Kode & "),1,0)"
End If

With lo.ListColumns("Visi").DataBodyRange
.Value = Kode
.Value = .Value
End With

Kode = ""
For Each pf In pt.RowFields
If pf.Name <> "Data" And pf.Name <> "Values" Then
Kode = Kode & "[" & pf.Name & "]&"
End If
Next pf

For Each pf In pt.ColumnFields
If pf.Name <> "Data" And pf.Name <> "Values" Then
Kode = Kode & "[" & pf.Name & "]&"
End If
Next pf

If Right(Kode, 1) = "&" Then
Kode = Left(Kode, Len(Kode) - 1)
Kode = "=IF([Visi]=1," & Kode & "&[" & tocount & "],0)"
End If
If Kode = "" Then
Kode = "=IF([Visi]=1,[" & tocount & "],0)"
End If

With lo
.ListColumns("Kode").DataBodyRange.FormulaR1C1 = Kode
.ListColumns("Kode").DataBodyRange.Value = .ListColumns("Kode").DataBodyRange.Value
.Range.Sort key1:="Kode", order1:=xlDescending, Header:=xlYes
.ListColumns("Unik").DataBodyRange.FormulaR1C1 = "=IF(RC[-1]<>R[-1]C[-1],1,0)*[Visi]"
.ListColumns("unik").DataBodyRange.Value = .ListColumns("unik").DataBodyRange.Value
End With

With pt
.PivotCache.Refresh
.PivotFields(" Unik").NumberFormat = "#"
.DataBodyRange.Font.Size = Range("a1").Font.Size
.DataBodyRange.Font.ColorIndex = xlAutomatic
End With

pt.PivotFields(" Unik").NumberFormat = "#,##0"
On Error Resume Next
Range("f1").Select
For rf = 1 To pt.RowFields.Count
If pt.RowFields(rf).Name <> "Data" And pt.RowFields(rf).Position <> pt.RowFields.Count Then
str2 = pt.RowFields(rf).Name & "[All;Total] ' Unik'"
pt.PivotSelect str2, xlDataOnly, True
Selection.NumberFormat = """"""
End If
Next


For rf = 1 To pt.ColumnFields.Count
If pt.ColumnFields(rf).Name <> "Data" And pt.ColumnFields(rf).Position <> pt.ColumnFields.Count Then
str2 = pt.ColumnFields(rf).Name & "[All;Total] ' Unik'"
pt.PivotSelect str2, xlDataOnly, True
Selection.NumberFormat = """"""
End If
Next

If pt.RowFields.Count > 0 Then
pt.PivotSelect "' Unik' 'Column Grand Total'", xlDataOnly, True
Selection.NumberFormat = """"""
End If

If pt.ColumnFields.Count > 0 Then
pt.PivotSelect "' Unik' 'Row Grand Total'", xlDataOnly, True
Selection.NumberFormat = """"""
End If

On Error GoTo 0
Range("c1").Select
Application.EnableEvents = True


End Sub


131 comments:

  1. Thanks for this - saved my life at work today!

    ReplyDelete
  2. Excellent code, saved a lot of my time! Many thanks!

    ReplyDelete
  3. Works great!! Even the totals were correct. Why try to hide them?

    ReplyDelete
  4. pt.sourcedata makes the same string as addreslocal. So if english isn't the original language of your installed excel, this causes problems. In dutch for example, this is R..K.. and that's why I get an error on the following row, which I corrected

    Set wd = ws.Range(Application.ConvertFormula(TranslateLocal2RC(pt.SourceData), fromreferencestyle:=xlR1C1, toreferencestyle:=xlA1)).Parent

    Therefore the UDF below translates the local address to R1C1

    Function TranslateLocal2RC(SheetRange As String)
    TranslateLocal2RC = SheetRange
    On Error Resume Next
    splits1 = Split(Range("A1").AddressLocal(, , xlR1C1), "1")
    splits2 = Split(ActiveSheet.PivotTables(1).SourceData, "!")
    If UBound(splits1) = 2 And UBound(splits2) = 1 Then
    splits2(1) = Replace(splits2(1), splits1(0), "R")
    splits2(1) = Replace(splits2(1), splits1(1), "C")
    TranslateLocal2RC = Join(splits2, "!")
    End If
    End Function

    ReplyDelete
  5. Hi- i'm trying to use this, but when i refresh nothing happens. It's been a while since i wrote/used any macros, and never have i done it in Excel 2007, so i'm probably missing something completely obviuos. I'm not sure i'm pointing the macro to my pivot table sheet or not. I guess i don't fully understand your instruction:

    "-Paste the code in the sheet module where is your Pivot Table (be careful of the name) and nowhere else. It shouldn’t break the rows"

    can you dumb that statment down for me with specific instruction?

    ReplyDelete
  6. Fantastic. Thanks very much.
    This is something that I have wanted to do for a long time. Very impressive work and easy instructions to follow.

    ReplyDelete
  7. This will not work if the source of your PIVOT table is external data such SQL Stored Procedure

    ReplyDelete
    Replies
    1. As mentioned above "Data must be within the workbook (no remote connection to database)"

      Why knock what is a very good piece of code, without reading the requirements. ;-(

      Delete
  8. It works! Thank YOU! :)

    ReplyDelete
  9. Bryan, try this:

    -Open Visual Basics Editor (Alt+F11)
    -Select "View", then "Object Browser", then select the sheet where your pivot table lives and copy the code there. Make sure you change tocount = "name" to the name of the field you would like to count.

    I hope this helps.

    ReplyDelete
  10. Bryan, the original message I posted had an error. try this instead:

    -Open Visual Basics Editor (Alt+F11)
    -Press Control+R (opens project explorer)
    -Select the sheet that holds the pivot table you would like to improve.
    -paste the code, be sure to change "name" to the name of the pivot table field you would like to count.

    I hope this helpls.

    ReplyDelete
  11. "Installation :
    -Create your Pivot Table (only one please)"

    So the code will not work if I have two pivot tables in separate sheets in the workbook, even if the code is only put into each individual sheet?

    ReplyDelete
  12. Hello Crystal D,
    I think it should work if there's only one pivot in the sheet where you put the code. However, still beter to test on a copy.

    Lazyvba

    ReplyDelete
  13. Any thoughts on if this could be modified to work for Excel 2003 for those of us stuck in the dark ages of Excel?

    ReplyDelete
  14. Hello Brian,
    Unfortunately, making it work for 2003 would require to code the table ability of excel 2007. Excel 2003 do have something like "excel list", for maybe less painful coding, but I don't have anymore access to Excel 2003 to try.
    Regards

    ReplyDelete
  15. Hi. I've been searching for this solution for a while now and am glad to come across this blog. However, I've never used macro and having a hard time. I tried Rory's instruction above and opened Project Explorer. When you mentioned paste the "code", does that mean copy and paste evertyhing up and above (started after "The Thing" and ended with "End Sub"? I then replaced all that has "Name" with the field i want to change in my pivot table. I got out refreshed the pivot but it didnt work. Sorry, I'm a dumbie when it comes to macro so I must have done something wrong. Can someone help me please? Thank you!!!

    ReplyDelete
  16. Hey,

    Just tried to use your macro. It didn't complete within half an hour so I shut it down. Do you think you could come up with some sort of way to show a progress bar?
    My data set is 68 columns and nearly 50000 rows.

    ReplyDelete
  17. hello,
    Anonymous: I will try to post an illustrated walkthrough.

    Moonfish: I do admit your data set size require some time. just in case, you confirm you don't have formulas in your dataset?( if yes try with values only). Unfortunately, the time consuming steps are few table manipulation(excel operations), so any progress bar would not be relevant. Do you want to try with a lighter set?

    Regards

    ReplyDelete
  18. Just tried on a data set 250 000 *12, it took 20 seconds.

    ReplyDelete
  19. Hi,

    How do I get this code to ignore blank spaces ?

    Thanks

    ReplyDelete
  20. Hello,
    I suppose you have field names with blank spaces.
    The best way is to replace space by an underscore.
    Regards

    ReplyDelete
  21. Their isnt anything I can change to have it stop counting the blank cells ? It works perfectly except it counts the first blank cell in each pivot which I guess is unique....

    ReplyDelete
  22. Counting the blank cells: could you send an exemple?

    ReplyDelete
  23. Whats your email address ?

    ReplyDelete
  24. should have got a link...as you can see I added blank cells to column B, even though it only counts the first one, i want to see if their is a way to have it ignore the cells and not count them at all

    ReplyDelete
  25. Ok, easy way is to put Row B in filter area and select everything except blank.

    ReplyDelete
  26. Is that the only way ?

    ReplyDelete
  27. Nevermimd, I just used Sumproduct command that made things easier

    ReplyDelete
  28. Thanks a lot for the code!

    ReplyDelete
  29. I have been working all day to get a formula to work and found this. Amazing and solved my problem. I really appreciate all the work you put in to this and for sharing with all of us.

    ReplyDelete
  30. I can't get this to work. Where should I see the "Unik" option? Should it be in the menu which appears when I right-click on the pivot table?
    (Posted this as Anonymous cos I don't understand the "Comment as:" dropdown!)

    ReplyDelete
  31. Last week, I placed the code in the 'module' section of VB, it didn't work, then I followed Rory's advice and put the code in the worksheet. When I refreshed it worked and added Unik as a field chosen within the data columns. Worked well.

    However, this week, I used new data for a weekly report and it didn't work. I tried the same (clearing the code, then putting it back in remembering to replace "name" in the code).

    ReplyDelete
  32. Following on from my post on 15-Aug at 13:27...
    I never knew you could have VBA in a Sheet so I had been pasting the code into a separate module. I should have read Rory's advice but didn't spot it till Dcow posted.

    ReplyDelete
  33. After 4 Hours of struggle gave up!!

    ReplyDelete
  34. Do you have an updated one for Excel Mac 2011? Thanks.

    ReplyDelete
  35. Will this work with Excel 2010? I don't see "Unik"

    ReplyDelete
  36. I'm using excel 2007, and can not get this to work. I paste the vba onto the correct sheet, set the field name, then refresh the table. It just blinks and nothing happens. Any ideas?

    Thanks

    ReplyDelete
  37. I did what you suggest, and it works.
    However, if you want to count the number of occurrences of a single value in a list, it seems there might be an easier way.
    Create the list twice with a different label for the second copy next to the first. ( List1, List2)
    Select both lists and create a pivot table.
    List1 goes into the Row Labels and List2 goes into the Values.
    Change the 'Value Field Settings' for the 'Values' from Sum to Count.

    Now you should have a table of values and the number of times that value is in List1.

    You can then hide List2 to restore the table view if you have more than one column of data.

    ReplyDelete
  38. Thank you!!! Thank you!!! Thank you!!! Worked great... I just cant believe Microsoft hasnt implemented this in Excel

    ReplyDelete
  39. I tried your macro, it showed "unik", but it counted nothing. the whole column is empty :( What did i do wrong? Please help.

    ReplyDelete
  40. I tried this and it worked great....any way to tweak it to cover the following:

    I want to count data that is listed many times only once....so if I have a product code sold to many customers...it shows it as a count of 20...I want to only count it once. Is this modification possible?

    ReplyDelete
  41. I want to do something simple. I want to count the numbers of words in a column and have a total shown in a cell at the bottom of the column. The words are all different and some cells contain "#N/A" because VLOOKUP was not able to find a match to put in the cell. Anyone have any suggestions? Thanks in advance.

    ReplyDelete
  42. This ROCKS! My life just got easier and I appreciate you posting this for all to use.

    ReplyDelete
  43. Amazing. I have no VB experience and this worked first time. Thank you for sharing.

    ReplyDelete
  44. Thank you, thank you, thank you

    ReplyDelete
  45. you absolute ripper
    works like a charm for me
    much kudos to you, sir

    ReplyDelete
  46. This is really amazing and right on. Question though, if I want to display the Grand Total, how do I go about it? I don't want to hide the totals?

    ReplyDelete
  47. This code is amazing.

    Is there any way to make it work with Grouping?

    ReplyDelete
  48. Great code, and thanks.

    I have an intermittent problem where the line
    .RowAxisLayout xlTabularRow
    causes the referenced PT object to disappear.
    I have to re-establish the ref immediately afterwards with something like
    Set pt = wp.PivotTables(1)

    Anyone else had this problem?

    ReplyDelete
  49. Excellent code. Thanks.

    Make sure that no vlookups are being done, copy and paste the data.

    ReplyDelete
  50. I wish this could work for me. I pasted the code into the VB worksheet, changed the name of the field, refreshed pivot and got values of "blank" for unik... Any thoughts? thank you!

    ReplyDelete
    Replies
    1. Same here. But it sure looks promising.

      Delete
  51. I have a dutch excel version and it doesn`t work. Not even with the correction. Could anyone please help out?

    ReplyDelete
  52. Brilliant! Take a bow. Worked for me and saved some valuable hours!!!

    ReplyDelete
  53. I am getting an error that says "run time error 1004 this operation is attempting to change a filtered range on your worksheet and cannot be completed. To complete this operation, autofilters in the sheet need to be removed."

    Help?

    ReplyDelete
  54. Great code, great instructions.

    ReplyDelete
  55. Thanks a lot for this!

    Works perfectly. Although slowing down significantly with larger files.

    Great work!

    ReplyDelete
  56. Excellent solution for what I needed at work. Thank you for sharing this and explaining how to use it.

    At least in my case, it is true that this does not work correctly for the total column (which calculates the sum of unique values in each category, not the number of unique values in the total dataset). As stated above, the text in this cell is well-hidden, so there's no risk of displaying incorrect data.

    I recommend populating the pivot table with the element in question, and then applying the macro, as the author states. This morning, I reversed the steps, and as a result *all* the elements in the total column were hidden, not only the unique count. Not a huge problem in my case, but odd and unexpected.

    Would be even better if it worked

    ReplyDelete
  57. My apologies - the above comment was meant to end with the sentence "Would be even better if it worked for totals as well."

    ReplyDelete
  58. It's works! Can;t believe it... Thank God you're here to save the day!
    Bless you, bless you!

    ReplyDelete
  59. This script worked for me once when I used a simple Pivot. But I have a more complex pivot that it seems to hate. When I get to the point where I refresh that data, I get a run-time error. When I debug, it highlights line 148:
    .ListColumns("Kode").DataBodyRange.FormulaR1C1 = Kode

    I don't know what that means, or how to fix it...but the Unik column will appear in the pivot, but it will contain no values (not hidden values, no values). When I check the data source, indeed the Visi column has all ones, but the Kode and Unik columns are blank.

    My data has 96k rows of data....44 columns (before the 3 added by this macro).

    Any thoughts - thanks!

    ReplyDelete
    Replies
    1. Same here. At the moment it stops, the Kode string value is: "=IF([Visi]=1,[Month]&[Source]&[SR #],0)". I know VBA (moderately) but the code is rather uncommented and tracing back yielded no specific result.

      Delete
  60. Great code. I have never used VB before and I was able to pull this off no problemo! However, I have found a small error, although perhaps it is just me.

    It looks like the first row is having an extra count in there...(I have manually counted and I have 9 unique values that should appear in the first row, but the pivot is showing 10). My only guess is that perhaps it is counting the title??? All the rest of teh values seem to be acurate, it is just the top row.

    Has anyone else come across this? Let me know if there is any solution.

    But...Fantastic code and fantastic explanation on how to use it. Thanks Very Much!!!

    ReplyDelete
  61. The code worked great for me! Thanks. One note I had to save my file in a macro enabled file. (.xlsm) for it to work.

    ReplyDelete
  62. This is wonderful!! Thank you.

    ReplyDelete
  63. Thanks ever so much for this! Works a treat! One question however, how do I get all totals to display? They're visible during the macro execution but are hidden after.

    ReplyDelete
  64. Many thanks for this - seems to be nearly working but i am getting a debug request from excel for the following line...

    .ListColumns("Kode").DataBodyRange.FormulaR1C1 = Kode

    Any ideas?

    ReplyDelete
  65. Total of Unique Count works for me. Both Row and Column.
    Grouping is also working for me.

    Not sure why it is working but no complains. Did numerous setting to make sure values are correct. Tested my old reports.

    ReplyDelete
  66. David, your problem might come from columns which belong to groups. I.e. when you group dates by months, quarters or years.
    I modified the code for that purpose since I had the same problem.

    Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
    'by lazyvba.blogspot.com

    Dim countStr As String
    Dim tocount As String
    tocount = InputBox("Enter field name for unique count")

    countStr = "# of " & tocount

    Application.EnableEvents = False

    Dim wb As Workbook, ws, wd, wp As Worksheet, _
    pt As PivotTable, pf As PivotField, _
    pi As PivotItem, str, Unique_Item_Criteria, totr, totc As String, c, cell, rng As Range, _
    li, lo As ListObject, loc As ListColumn, rng1, rng2 As Range, t As Integer

    Set wb = ActiveWorkbook
    Set wp = ActiveSheet
    Set pt = wp.PivotTables(1)
    pt.Name = "PT"
    t = 0
    For Each ws In wb.Worksheets
    For Each li In ws.ListObjects
    If li.Name = pt.SourceData Then
    li.Name = "Datas"
    Set lo = li
    t = 1
    End If
    Next li
    Next ws

    If t = 0 Then
    For Each ws In wb.Worksheets
    On Error Resume Next
    Set wd = ws.Range(Application.ConvertFormula(pt.SourceData _
    , fromreferencestyle:=xlR1C1, toreferencestyle:=xlA1)).Parent
    On Error GoTo 0
    Next ws

    If wd.ListObjects.Count = 0 Then
    wd.ListObjects.Add(xlSrcRange, wd.Range(Application.ConvertFormula _
    (pt.SourceData, fromreferencestyle:=xlR1C1, toreferencestyle:=xlA1 _
    )), , xlYes).Name = "Datas"
    Else
    wd.ListObjects(1).Name = "Datas"
    End If
    Set lo = wd.ListObjects("Datas")
    End If

    t = 0
    For Each pf In pt.PivotFields
    If pf.Name = countStr Then t = 1
    Next pf
    If t = 1 Then GoTo testCount

    ReplyDelete
  67. Setup:
    lo.ListColumns.Add
    lo.ListColumns(lo.ListColumns.Count).Name = "Visible_Item"
    lo.ListColumns.Add
    lo.ListColumns(lo.ListColumns.Count).Name = "Unique_Item_Criteria"
    lo.ListColumns.Add
    lo.ListColumns(lo.ListColumns.Count).Name = countStr

    With pt
    .ChangePivotCache ActiveWorkbook.PivotCaches. _
    Create(SourceType:=xlDatabase, SourceData:="Datas", Version:= _
    xlPivotTableVersion12)
    .PivotCache.Refresh
    .InGridDropZones = True
    .RowAxisLayout xlTabularRow
    End With

    With pt.PivotFields(countStr)
    .Orientation = 4
    .Caption = " " & countStr
    .Function = xlSum
    End With

    testCount:
    t = 0
    For Each pf In pt.DataFields
    If InStrB(pf.Name, countStr) > 0 Then
    t = 1
    If pf.Name <> (" " & countStr) Then
    With pf
    .Caption = " " & countStr
    .Function = xlSum
    End With
    End If
    End If
    Next pf
    If t = 0 Then
    Application.EnableEvents = True
    Exit Sub
    End If

    Unique_Item_Criteria = ""
    With pt
    For Each pf In pt.PageFields
    If pf.AllItemsVisible = False Then
    For Each pi In pf.PivotItems
    If pi.Visible = False Then
    If Unique_Item_Criteria = "" Then
    Unique_Item_Criteria = "[" & pf.Name & "]" & "<>" & """" & pi.Name & """"
    Else
    Unique_Item_Criteria = Unique_Item_Criteria & "," & "[" & pf.Name & "]" & "<>" & """" & pi.Name & """"
    End If
    End If
    Next pi
    End If
    Next pf
    End With

    If Unique_Item_Criteria = "" Then
    Unique_Item_Criteria = 1
    Else
    Unique_Item_Criteria = "=IF(and(" & Unique_Item_Criteria & "),1,0)"
    End If

    With lo.ListColumns("Visible_Item").DataBodyRange
    .Value = Unique_Item_Criteria
    .Value = .Value
    End With

    Unique_Item_Criteria = ""

    For Each pf In pt.RowFields
    If pf.Name <> "Data" And pf.Name <> "Values" And pf.Name <> "Years" And pf.Name <> "Quarters" And pf.Name <> "Activity Date" Then
    Unique_Item_Criteria = Unique_Item_Criteria & "[" & pf.Name & "]&"
    End If
    Next pf

    For Each pf In pt.ColumnFields
    If pf.Name <> "Data" And pf.Name <> "Values" And pf.Name <> "Years" And pf.Name <> "Quarters" And pf.Name <> "Activity Date" Then
    Unique_Item_Criteria = Unique_Item_Criteria & "[" & pf.Name & "]&"
    End If
    If InStr(1, LCase(pf.Name), "date") Then
    Unique_Item_Criteria = Unique_Item_Criteria & "Year([" & pf.Name & "])&Month([" & pf.Name & "])&"
    End If
    Next pf

    ReplyDelete
  68. If Right(Unique_Item_Criteria, 1) = "&" Then
    Unique_Item_Criteria = Left(Unique_Item_Criteria, Len(Unique_Item_Criteria) - 1)
    Unique_Item_Criteria = "=IF([Visible_Item]=1," & Unique_Item_Criteria & "&[" & tocount & "],0)"
    End If
    If Unique_Item_Criteria = "" Then
    Unique_Item_Criteria = "=IF([Visible_Item]=1,[" & tocount & "],0)"
    End If
    Debug.Print Unique_Item_Criteria
    With lo
    .ListColumns("Unique_Item_Criteria").DataBodyRange.FormulaR1C1 = Unique_Item_Criteria
    .ListColumns("Unique_Item_Criteria").DataBodyRange.Value = .ListColumns("Unique_Item_Criteria").DataBodyRange.Value
    .Range.Sort key1:="Unique_Item_Criteria", order1:=xlDescending, Header:=xlYes
    .ListColumns(countStr).DataBodyRange.FormulaR1C1 = "=IF(RC[-1]<>R[-1]C[-1],1,0)*[Visible_Item]"
    .ListColumns(countStr).DataBodyRange.Value = .ListColumns(countStr).DataBodyRange.Value
    End With

    With pt
    .PivotCache.Refresh
    .PivotFields(" " & countStr).NumberFormat = "#"
    .PivotFields(" " & countStr).NumberFormat = "# ?/?"
    End With

    For Each cell In pt.DataBodyRange
    If cell.NumberFormat = "# ?/?" Then
    If pt.RowFields.Count = 0 Then
    Set rng1 = cell
    Else
    Set rng1 = wp.Range(Cells(cell.Row, 1), Cells(cell.Row, cell.Column - 1))
    End If

    If pt.ColumnFields.Count = 0 Then
    Set rng2 = cell
    Else
    Set rng2 = wp.Range(Cells(1, cell.Column), Cells(cell.Row - 1, cell.Column))
    End If

    Set c = Union(rng1, rng2).Find("total", LookIn:=xlValues)
    totr = Cells(cell.Row, pt.DataBodyRange.Column - 1).Value
    totc = Cells(pt.DataBodyRange.Row - 1, cell.Column)

    If Not c Is Nothing Or totr = "" Or totc = "" Then
    ' cell.Font.ColorIndex = 2
    cell.Font.Size = 10
    Else
    cell.Font.ColorIndex = xlAutomatic
    cell.Font.Size = Range("a1").Font.Size
    End If
    End If
    Next

    pt.PivotFields(" " & countStr).NumberFormat = "#"
    Application.EnableEvents = True
    End Sub

    ReplyDelete
  69. I had to split the vba code into 3 parts. You have to reassemble it. A bit annoying that the comments box only takes a limited amount of text at once.

    ReplyDelete
  70. Hmm that still breaks at this line for me
    .ListColumns("Unique_Item_Criteria").DataBodyRange.FormulaR1C1 = Unique_Item_Criteria

    ReplyDelete
  71. Hi d.c,
    Did you check the content of the variable Unique_Item_Criteria? Likely the formula in there is the problem and the code that assembles the formula needs modification.

    ReplyDelete
  72. Hello,

    This is really helpful, thanks a lot !
    Note that this does not work with a non-English installation of Excel, since formulas and a few keywords are not necessarily the same as what appears in the code.
    I have made a version that works in French as well: I would post it here except I am not sure I can.

    Thanks again !

    ReplyDelete
    Replies
    1. Hello Bertrand, I was curious to know if it was working with French Excel. Apparently not. Do you want me to publish it here?

      Regards

      Lazy VBA

      Delete
  73. Is there any way to get this to work with external data sources? I am linking to an SQL database.

    Thanks,
    Chris.

    ReplyDelete
    Replies
    1. Hi Chris, you can combine it with the pivot compressor, my other post.
      I will try one day to merge both in one for better speed.
      Regards.

      Lazy VBA

      Delete
  74. AWESOME Code!
    It's a bit slow but it saves a whole lot of time!

    thanks!!!

    ReplyDelete
  75. It would be better if the calculations didn't happen every time you changed the pivot ... only if you changed the data.

    Although this works, I think that if I'm going to send data off to people, it will be better to copy the data in question, and then use the standard (excel 2007) Data/Eliminate Duplicates feature to get a static dataset for processing.

    ReplyDelete
  76. How would you implement it if you have different pivot tables on one worksheet where you want to do an unique count?

    ReplyDelete
  77. Aniway you can get this to work on Spanish? Please
    I'm getting error 91

    ReplyDelete
  78. Hi, in this line

    If wd.ListObjects.Count = 0 Then

    I have this error msg (wd.ListObjects.Count = 'Object variable or With block variable not set')

    ReplyDelete
  79. It works! This is awesome, thank you!

    ReplyDelete
  80. I also get the error d.ListObjects.Count = 'Object variable or With block variable not set')

    I had been using the code with no issues for a while.

    Any ideas?

    ReplyDelete
    Replies
    1. Hello Mike,
      Unfortunately no idea.
      Could you send a version with dummy data?
      Regards

      Delete
  81. I have been using your code for about six months now and it has worked great. Unfortunately my pivot is now about to change and I need to know: is there some way I can exclude a column from "Kode"? I do not want it to be in the kode-string since it stops counting the unique I'm after then.

    Thanks!

    ReplyDelete
  82. I LOVE YOU :*

    Where have you been all my pivot table making life?!

    Works perfectly!!! Cheers!!!

    ReplyDelete
  83. Michael Fernandes29 March 2013 at 00:32

    This code works great.

    However it does not reflect the unique count, when one of the Row Label is a Date and is grouped by Months.

    Did anyone have the same issue on a Grouped Row. Interested in knowing is you have a solution.

    ReplyDelete
  84. Not sure how to get the total columns to show. There is data there, but I can't get the data to show up on worksheet.

    Thanks,
    Bill

    ReplyDelete
  85. Perfect. A real life saver.

    ReplyDelete
  86. Hi! I'm using a formula in the Name Manager to have a dinamic range in my pivot table. The thing is, I tried to use this macro, but it doesn't work. I press debug, and the macro stop here:

    wd.ListObjects.Add(xlSrcRange, wd.Range(Application.ConvertFormula _
    (pt.SourceData, fromreferencestyle:=xlR1C1, toreferencestyle:=xlA1 _
    )), , xlYes).Name = "Datas"

    Any idea?

    ReplyDelete
  87. THANK YOU!!!!!!!!!!!!!!!!

    ReplyDelete
  88. I am trying to total a field in my pivot to exclude duplicates. The unik sum is still including the duplicates......... is there any way to get it to sum properly?

    ReplyDelete
  89. Thanks for sharing! This is wonderful!!!

    ReplyDelete
  90. Thanks for sharing; it works and saves many workhours.
    I'll be following this blog from now on :)
    Best wishes from IStanbul........

    ReplyDelete
  91. Very helpful. Thanks!

    ReplyDelete
  92. Is it possible for this to be utilized to count the unique records with two variables? Say name & month?

    ReplyDelete
    Replies
    1. I combined the two cells =CellA & CellB in a new column in order to accomplish this, so never mind. Thanks for this code, it's amazing.

      Delete
  93. Apparently Excel 2013 now has a 'Distinct Count' summary type in Pivot Tables.

    ReplyDelete
  94. I don't see the Unik. Where does it supposed to appear after adding the VBA?

    ReplyDelete
  95. This is awesome!!! Thanks for posting ^_^

    ReplyDelete
  96. I get a runtime 1004 error at line:

    .ListColumns("Kode").DataBodyRange.FormulaR1C1 = Kode

    ReplyDelete
    Replies
    1. Same here.
      I noticed that there were more people encountering to this error.
      Anyone found the solution?

      Delete
  97. Thanks a Ton!!
    God Bless u :)

    ReplyDelete
  98. Thanks for the code, works fine with over 400k lines of data!

    ReplyDelete
  99. Perfect! Thank you for sharing :)

    ReplyDelete
  100. This was totally awesome and saved me a ton of time. Thanks for the code!

    ReplyDelete
  101. Just found this. Thank you so much! Saved me hours and/or days of work!

    ReplyDelete
  102. Hats off Sir !! Saved me hours of work!

    ReplyDelete
  103. Fabulous stuff!

    ReplyDelete
  104. This is great! However, I'm trying to reference the Unik column in a table and the formula doesn't seem to come up correctly and when I write it myself, it doesn't work either. Does anyone know how to get around this?

    When I click into the pivot the formula, it returns a #REF error - =GETPIVOTDATA($A$4,"'01492 People and Organisational Chg' 'Current grade'['Level 4 Director';Data,Sum] ' Unik'")

    When I write it my self, it returns a #REF error - =GETPIVOTDATA(" Unik",'Fully Avail or on Internal List'!$A$4,"Competency Group","01492 People and Organisational Chg","Current grade","Level 4 Director")

    ReplyDelete
  105. Amazing, thank you so much - I owe you many drinks.

    ReplyDelete
  106. Hi - great code thanks. I have 2 columns that I need unique values for. How would I implement this plse?

    ReplyDelete
  107. Please help. I am using Excel 2010. I tried to follow Rory's advice and post the code in worksheet 14. On the left side it shows Microsoft excel objects and the sheets number and the names in parenthesis. I select sheet14 , and right hand side show "General" in the one dropdown and Declarations in the other. I try to paste the code in the empty box under the dropdowns and the left side switches to highlight the source worksheet of the pivot. I pasted the code, changed the tocount to my field, and refreshed the pivot . Unik does not show up anywhere. Is it suppose to show up in the field list ?

    ReplyDelete
  108. Fantastic, a great simple way to get unique counts in pivot tables, well done and many thanks.

    ReplyDelete
  109. Used to work for me perfectly in Excel 2010 and 2003. I now have 2013 and it doesn't work. Not sure why!

    ReplyDelete
  110. THANK YOU - THANK YOU - THANK YOU!!! Fast, easy solution that gets results. Appreciate this so much!

    ReplyDelete
  111. This is great :).
    Is there a way to make it work for TWO pivot tables in the same excel workbook? They can go in different sheets if need be. Both pivot tables are using the same source data. Thanks

    ReplyDelete
  112. Thanks you! i've used this code so many times now and it works great. Huge time saver. Thanks for sharing.

    ReplyDelete
  113. Today, I went to the beach front with my kids. I found a sea shell and gave it to my 4 year old daughter and said "You can hear the ocean if you put this to your ear." She put the shell to her ear and screamed. There was a hermit crab inside and it pinched her ear. She never wants to go back! LoL I know this is totally off topic but I had to tell someone!

    ReplyDelete
  114. Oh my goodness! Awesome article dude! Many thanks, However I am encountering difficulties with your RSS. I don't understand the reason why I cannot subscribe to it. Is there anybody else having identical RSS issues? Anybody who knows the solution will you kindly respond? Thanks!!

    ReplyDelete
  115. Just want to say your article is as astonishing. The clarity for your publish is just great and i can think you're an expert in this subject. Well together with your permission allow me to grab your RSS feed to keep up to date with coming near near post. Thank you a million and please carry on the rewarding work.

    ReplyDelete
  116. Hello Dear, are you genuinely visiting this website regularly, if so then you will absolutely get pleasant experience.

    ReplyDelete
  117. No matter if some one searches for his required thing, thus he/she wishes to be available that in detail, therefore that thing is maintained over here.

    ReplyDelete
  118. Sweet blog! I found it while surfing around on Yahoo News. Do you have any tips on how to get listed in Yahoo News? I've been trying for a while but I never seem to get there! Appreciate it

    ReplyDelete
  119. You really make it seem so easy with your presentation but I find this topic to be really something that I think I would never understand. It seems too complicated and very broad for me. I am looking forward for your next post, I will try to get the hang of it!

    ReplyDelete