Counting the number of different duplicates in a list

[francorbusetti]

I have a list (column, say) of numbers. They will be recalculated continuously as part of an optimization routine.
I need to generate another list (column) that counts the number of different duplicates in the original list, preferably ranked. (This is what the Tally command does in Mathematica.)
e.g. {21 7 3 7 7 3} => {3 2 1}
{21 7 3 7 21 2} => {2 2 1 1}
{21 7 3 2 1 0} => {1 1 1 1 1 1}
Any ideas?

 

[mohadin]

Hi
If you data in columns (A,B,C)
The result in colums (B,D,F)

Try this (but the result not ranked)

Sub tester()
    Dim a, x, i, k, itm, j, lr
    ReDim x(1 To 7)
    For j = 1 To 6 Step 2
        With CreateObject("scripting.dictionary")
            For i = 1 To Cells(Rows.Count, j).End(xlUp).Row - 1
                a = Application.Transpose(Range(Cells(2, j), Cells(7, j)))
                If Not .exists(a(i)) Then
                    .Add a(i), 1
                Else
                    .Item(a(i)) = .Item(a(i)) + 1
                End If
            Next
            Cells(2, j + 1).Resize(.Count) = Application.Transpose(.items)
            .RemoveAll
        End With
    Next
End Sub

 

[mohadin]

Try this (Ranked)

Sub tester()
    Dim a, x, i, k, itm, j, lr
    Dim rng As Range
    ReDim x(1 To 7)
    For j = 1 To 6 Step 2
        With CreateObject("scripting.dictionary")
            For i = 1 To Cells(Rows.Count, j).End(xlUp).Row - 1
                a = Application.Transpose(Range(Cells(2, j), Cells(7, j)))
                If Not .exists(a(i)) Then
                    .Add a(i), 1
                Else
                    .Item(a(i)) = .Item(a(i)) + 1
                End If
            Next
            Cells(2, j + 1).Resize(.Count) = Application.Transpose(.items)
            Set rng = Cells(2, j + 1).Resize(.Count)
            ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
            ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=rng, _
                                                                    SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
            With ActiveWorkbook.Worksheets("Sheet1").Sort
                .SetRange rng
                .Header = xlGuess
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
            .RemoveAll
        End With
    Next
End Sub

 

[francorbusetti]

Thanks, appreciated. However, since the sheet is being recalculated continuously one can't use code. For the same reason one can't, for example, do the sorting manually.
Something like FREQUENCY is required, except there are no bins, only the actual values in the list.

 

[mohadin]

Hi
see if this meets your requirement
Sorry for the delay

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim a, x, i, k, itm, j, lr
    ReDim x(1 To 7)
        With CreateObject("scripting.dictionary")
            For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row - 2
                a = Application.Transpose(Range(Cells(2, 1), Cells(7, 1)))
                If Not .exists(a(i)) Then
                    .Add a(i), 1
                Else
                    .Item(a(i)) = .Item(a(i)) + 1
                End If
            Next
            Cells(2, 2).Resize(.Count) = Application.Transpose(.items)
            .RemoveAll
        End With
End Sub

This code should go to the sheet code (not module)

 

[Fluff]

Cross posted https://www.excelforum.com/excel-ge...number-of-different-duplicates-in-a-list.html

While we do not prohibit Cross-Posting on this site, we do ask that you please mention you are doing so and provide links in each of the threads pointing to the other thread (see rule 13 here along with the explanation: Forum Rules).
This way, other members can see what has already been done in regards to a question, and do not waste time working on a question that may already be answered.