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 .

You need to add that to both ranges like

For Each Cl In Worksheets("Sheet1").Range("A2", Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp))

 

[kbishop94]

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

I see now... Thank you!

 

[Fluff]

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

Glad to help & thanks for the feedback

 

[kbishop94]

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

Glad to help & thanks for the feedback

Well, now Im having trouble with getting it to work correctly with using the code inserted into a Workbook Open event(?) I dont think Im using the activate worksheet correctly... (since the code is gathering the data from Sheet1 and placing the result(s) into Sheet2. What exactly needs to be changed in the code so it runs correctly 'on open'? THank you again.

Here is the code I have for using a command button, which works flawlessly. Its gathering data from 2 separate columns (in Sheet1), running the tally to put them in order, and then putting the result in Sheet2. Just want it to do it as an on open event now.

Private Sub CommandButton3_Click()
 
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = False
 
   Dim Cl As Range
   Dim i As Long, j As Long
   Dim Ary, Temp1, Temp2
      With CreateObject("scripting.dictionary")
      For Each Cl In Range("B2", Range("B" & 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("J" & Rows.Count).End(xlUp).Offset(1).Resize(UBound(Ary) + 1, 2).Value = Ary
 
   Dim Dl As Range
   Dim ii As Long, jj As Long
   Dim AryA, Temp11, Temp22
      With CreateObject("scripting.dictionary")
      For Each Dl In Range("C2", Range("C" & Rows.Count).End(xlUp))
         If Not .exists(Dl.Value) Then
            .Add Dl.Value, 1
         Else
            .Item(Dl.Value) = .Item(Dl.Value) + 1
         End If
      Next Dl
      ReDim AryA(0 To .Count - 1, 0 To 1)
      For ii = 0 To .Count - 1
         AryA(ii, 0) = .Keys()(ii)
         AryA(ii, 1) = .Items()(ii)
      Next ii
   End With
 
   For ii = LBound(AryA, 1) To UBound(AryA, 1) - 1
      For jj = ii + 1 To UBound(AryA, 1)
         If AryA(ii, 1) < AryA(jj, 1) Then
            Temp11 = AryA(jj, 0)
            Temp22 = AryA(jj, 1)
            AryA(jj, 0) = AryA(ii, 0)
            AryA(jj, 1) = AryA(ii, 1)
            AryA(ii, 0) = Temp11
            AryA(ii, 1) = Temp22
         End If
      Next jj
   Next ii
 
   Range("L" & Rows.Count).End(xlUp).Offset(1).Resize(UBound(AryA) + 1, 2).Value = AryA
 
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 .

You need to specify what sheets you want the code to work on, like

Private Sub CommandButton3_Click()
 
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = False
 
   Dim Cl As Range
   Dim i As Long, j As Long
   Dim Ary, Temp1, Temp2
   With CreateObject("scripting.dictionary")
      For Each Cl In [COLOR=#ff0000]Sheets("Sheet1")[/COLOR].Range("B2", [COLOR=#ff0000]Sheets("Sheet1")[/COLOR].Range("B" & 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
 
   [COLOR=#0000ff]Sheets("Sheet2")[/COLOR].Range("J" & Rows.Count).End(xlUp).Offset(1).Resize(UBound(Ary) + 1, 2).Value = Ary
 
   Dim Dl As Range
   Dim ii As Long, jj As Long
   Dim AryA, Temp11, Temp22
   With CreateObject("scripting.dictionary")
      For Each Dl In [COLOR=#ff0000]Sheets("Sheet1")[/COLOR].Range("C2", [COLOR=#ff0000]Sheets("Sheet1")[/COLOR].Range("C" & Rows.Count).End(xlUp))
         If Not .exists(Dl.Value) Then
            .Add Dl.Value, 1
         Else
            .Item(Dl.Value) = .Item(Dl.Value) + 1
         End If
      Next Dl
      ReDim AryA(0 To .Count - 1, 0 To 1)
      For ii = 0 To .Count - 1
         AryA(ii, 0) = .Keys()(ii)
         AryA(ii, 1) = .Items()(ii)
      Next ii
   End With
 
   For ii = LBound(AryA, 1) To UBound(AryA, 1) - 1
      For jj = ii + 1 To UBound(AryA, 1)
         If AryA(ii, 1) < AryA(jj, 1) Then
            Temp11 = AryA(jj, 0)
            Temp22 = AryA(jj, 1)
            AryA(jj, 0) = AryA(ii, 0)
            AryA(jj, 1) = AryA(ii, 1)
            AryA(ii, 0) = Temp11
            AryA(ii, 1) = Temp22
         End If
      Next jj
   Next ii
 
  [COLOR=#0000ff] Sheets("Sheet2")[/COLOR].Range("L" & Rows.Count).End(xlUp).Offset(1).Resize(UBound(AryA) + 1, 2).Value = AryA
 
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
 
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 .

You need to specify what sheets you want the code to work on, like

Thank you, Fluff.

I was trying to over-complicate it... if I kept it simple, I would have figured it out lol

 

[Fluff]

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

Glad to help & thanks for the feedback