need code for: (1) counting unique & duplicate values in a column, (2) display the results somewhere, (3) sort them .

[kbishop94]

See picture.. pretty self-explanatory (I hope at least)
Columns D & E show the result I am trying to do.

So I need to: provide a count all the unique entries, and a count for all the duplicate values too that are listed in column A, display the results somewhere on the same sheet.... then, sort them by the most entries for each name.
THis will ultimately be a 'workbook open' event as I need to have it calculate the tallys for all the columns (there will be 9 or 10 columns that I want to run the query for) whenever the user opens the workbook.

I have several columns total that I will be doing, but they are all pretty much the same as the one I am using for the example here. The example I used has names, and all the other columns will be all text as well.

I found some examples on here (and google) of doing bits and parts of what I was looking for, but nothing that does it all in the fashion that I am attempting to do here. Help!

 

[Fluff]

Re: pls help; need code for: (1) counting unique & duplicate values in a column, (2) display the results somewhere, (3) sort them .

How about

Sub getTally()

   Dim Cl As Range
   Dim Dic As Object
   Dim Ky As Variant
   
   Set Dic = CreateObject("scripting.dictionary")
   For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
      If Not Dic.exists(Cl.Value) Then
         Dic.Add Cl.Value, 1
      Else
         Dic.Item(Cl.Value) = Dic.Item(Cl.Value) + 1
      End If
   Next Cl
   For Each Ky In Dic.keys
      Range("D" & Rows.Count).End(xlUp).Offset(1).Resize(, 2).Value = Array(Ky, Dic(Ky))
   Next Ky
End Sub

 

[kbishop94]

Re: pls help; need code for: (1) counting unique & duplicate values in a column, (2) display the results somewhere, (3) sort them .

How about

THats perfect. Thank you!

Now, can I sort the results all in the same sequence, or do I need to make that a separate event? Thanks again. Fluff

 

[Fluff]

Re: pls help; need code for: (1) counting unique & duplicate values in a column, (2) display the results somewhere, (3) sort them .

Forgot about the sort. How about

Sub getTally()

   Dim Cl As Range
   Dim i As Long, j As Long
   Dim Ary, Temp1, Temp2
   
   With CreateObject("scripting.dictionary")
      For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
         If Not .exists(Cl.Value) Then
            .Add Cl.Value, 1
         Else
            .Item(Cl.Value) = .Item(Cl.Value) + 1
         End If
      Next Cl
      ReDim Ary(0 To .Count - 1, 0 To 1)
      For i = 0 To .Count - 1
         Ary(i, 0) = .Keys()(i)
         Ary(i, 1) = .Items()(i)
      Next i
   End With
   For i = LBound(Ary, 1) To UBound(Ary, 1) - 1
      For j = i + 1 To UBound(Ary, 1)
         If Ary(i, 1) < Ary(j, 1) Then
            Temp1 = Ary(j, 0)
            Temp2 = Ary(j, 1)
            Ary(j, 0) = Ary(i, 0)
            Ary(j, 1) = Ary(i, 1)
            Ary(i, 0) = Temp1
            Ary(i, 1) = Temp2
         End If
      Next j
   Next i
   Range("D" & Rows.Count).End(xlUp).Offset(1).Resize(UBound(Ary) + 1, 2).Value = Ary
End Sub

 

[kbishop94]

Re: pls help; need code for: (1) counting unique & duplicate values in a column, (2) display the results somewhere, (3) sort them .

Forgot about the sort. How about

Thank you! I just got it figured out myself. (yours is proabbly a better way to go tho. I just recorded a macro and then changed it some in order to capture the changing list of rows instead of having a set amount of rows. Going to insert yours now and see how it works.) Thanks again!!

 

[kbishop94]

Re: pls help; need code for: (1) counting unique & duplicate values in a column, (2) display the results somewhere, (3) sort them .

Forgot about the sort. How about

btw: Here is the code i ended up wiht after revising it to include other columns (like I said, I need to have it run the calculation on 9 or 10 columns when the workbook is opened) and with the sorting function thrown in too for the 2 columns now: (Is this the best way of going about this seeing that I have several other columns that I will be adding to the mix here? Or would it be better (simpler/faster) to go with what you suggested and revise it in order to adapt to adding multiple columns to it? THank you again for your help. I'm still very much a novice at VBA but I do love learning as much about it as I can.)

Private Sub CommandButton1_Click()

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = False

Dim Cl As Range
Dim Ky As Variant
   
Dim Dic As Object
Dim Cic As Object

Set Dic = CreateObject("scripting.dictionary")
Set Cic = CreateObject("scripting.dictionary")

For Each Cl In Range("A2", Range("A" & Rows.count).End(xlUp))
      If Not Dic.Exists(Cl.Value) Then
      Dic.Add Cl.Value, 1
      Else
      Dic.Item(Cl.Value) = Dic.Item(Cl.Value) + 1
End If
      
Next Cl

For Each Ky In Dic.Keys
      Range("D" & Rows.count).End(xlUp).Offset(1).Resize(, 2).Value = Array(Ky, Dic(Ky))
Next Ky

Dim Aa As Range
Dim Bb As Variant

For Each Aa In Range("B2", Range("B" & Rows.count).End(xlUp))
    If Not Cic.Exists(Aa.Value) Then
    Cic.Add Aa.Value, 1
    Else
    Cic.Item(Aa.Value) = Cic.Item(Aa.Value) + 1
    End If
        
Next Aa

For Each Bb In Cic.Keys
     Range("F" & Rows.count).End(xlUp).Offset(1).Resize(, 2).Value = Array(Bb, Cic(Bb))
        
Next Bb
 
Dim rCol As Long
    rCol = ActiveSheet.UsedRange.Rows.count
    
    Range(Cells(2, 4), Cells(rCol, 5)).Select
    Range(Cells(2, 4), Cells(rCol, 5)).Activate
    
    ActiveWorkbook.Worksheets("Sheet4").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet4").Sort.SortFields.Add Key:=Range(Cells(2, 5), Cells(rCol, 5)), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    
    With ActiveWorkbook.Worksheets("Sheet4").Sort
        .SetRange Range(Cells(2, 4), Cells(rCol, 5))
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    Range(Cells(2, 6), Cells(rCol, 7)).Select
    Range(Cells(2, 6), Cells(rCol, 7)).Activate
    
    ActiveWorkbook.Worksheets("Sheet4").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet4").Sort.SortFields.Add Key:=Range(Cells(2, 7), Cells(rCol, 7)), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    
    With ActiveWorkbook.Worksheets("Sheet4").Sort
        .SetRange Range(Cells(2, 6), Cells(rCol, 7))
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

 

[Fluff]

Re: pls help; need code for: (1) counting unique & duplicate values in a column, (2) display the results somewhere, (3) sort them .

For the dictionary part you could do

   Dim Cl As Range
   Dim Ky As Variant
   Dim Dic As Object
   Dim i As Long
   Dim Cols As Variant
   
   Set Dic = CreateObject("scripting.dictionary")
   Cols = Array([COLOR=#ff0000]1[/COLOR], [COLOR=#0000ff]4[/COLOR], [COLOR=#ff0000]2[/COLOR], [COLOR=#0000ff]6[/COLOR])
   For i = 0 To UBound(Cols) Step 2
      For Each Cl In Range(Cells(2, Cols(i)), Cells(Rows.Count, Cols(i)).End(xlUp))
         If Not Dic.Exists(Cl.Value) Then
            Dic.Add Cl.Value, 1
         Else
            Dic.Item(Cl.Value) = Dic.Item(Cl.Value) + 1
         End If
      Next Cl
      For Each Ky In Dic.Keys
         Cells(Rows.Count, Cols(i + 1)).End(xlUp).Offset(1).Resize(, 2).Value = Array(Ky, Dic(Ky))
      Next Ky
      Dic.RemoveAll
   Next i

Where the values in red are the columns you want to look at & the values in blue are where you want the results

 

[kbishop94]

Re: pls help; need code for: (1) counting unique & duplicate values in a column, (2) display the results somewhere, (3) sort them .

For the dictionary part you could do

Does the newest code you just posted REPLACE part of the other one, or is this all new code? (I cant get it to work either way, so I thought I better ask. lol)

 

[Fluff]

Re: pls help; need code for: (1) counting unique & duplicate values in a column, (2) display the results somewhere, (3) sort them .

It replaces this section

Dim Cl As Range
Dim Ky As Variant
   
Dim Dic As Object
Dim Cic As Object

Set Dic = CreateObject("scripting.dictionary")
Set Cic = CreateObject("scripting.dictionary")

For Each Cl In Range("A2", Range("A" & Rows.count).End(xlUp))
      If Not Dic.Exists(Cl.Value) Then
      Dic.Add Cl.Value, 1
      Else
      Dic.Item(Cl.Value) = Dic.Item(Cl.Value) + 1
End If
      
Next Cl

For Each Ky In Dic.Keys
      Range("D" & Rows.count).End(xlUp).Offset(1).Resize(, 2).Value = Array(Ky, Dic(Ky))
Next Ky

Dim Aa As Range
Dim Bb As Variant

For Each Aa In Range("B2", Range("B" & Rows.count).End(xlUp))
    If Not Cic.Exists(Aa.Value) Then
    Cic.Add Aa.Value, 1
    Else
    Cic.Item(Aa.Value) = Cic.Item(Aa.Value) + 1
    End If
        
Next Aa

For Each Bb In Cic.Keys
     Range("F" & Rows.count).End(xlUp).Offset(1).Resize(, 2).Value = Array(Bb, Cic(Bb))
        
Next Bb

of the code you supplied in post#6

 

[kbishop94]

Re: pls help; need code for: (1) counting unique & duplicate values in a column, (2) display the results somewhere, (3) sort them .

It replaces this section

OK. Got it.

Last question... (I hope):

Im having trouble using the code when referencing another sheet (within same workbook)

Original code you supplied is:

Dim Cl As Range
Dim i As Long, j As Long
Dim Ary, Temp1, Temp2
 
With CreateObject("scripting.dictionary")
[B]For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))[/B]

This gives me error 1004:

Dim Cl As Range
Dim i As Long, j As Long
Dim Ary, Temp1, Temp2
 
With CreateObject("scripting.dictionary")
[B]For Each Cl In Worksheets (“Sheet1”).Range("A2", Range("A" & Rows.Count).End(xlUp))[/B]