VBA Count multiple duplicates in array - arrays

Question

I have the same question as here: VBA counting multiple duplicates in array , but I haven't found an answer and with my reputation can't leave comment there.
I have an array with 150 numbers which could contain repetitive numbers from 1 to 50. Not always there are all 50 numbers in the array. Example of output of what I need:
- 10 times: 1, 2;
- 20 times: 3, 4 etc;
- 0 times: 5, 6, 7 etc.
I need to count how many combinations of duplicate numbers it has and what numbers are in those combinations including zero occurrence - which numbers are not in the array.
On mentioned above post there are solutions - but only when you know how many combinations of duplicates there are - and I don't know it - there could be 1 (all 150 numbers are equal) - ... - 20 ... up to 50 combinations if it contains all numbers from 1 to 50 three times each.
Appreciate any help and advice how to store output - finally it should be written to worksheet in the above mentioned format: [times] - [numbers] (here could be a string, example "5 - 6 - 7").
Here is what I've made for 5 combinations, but do 50 cases and then check 50 strings if they are empty or contain something to write to output is not very good option...
For i = 1 To totalNumbers 'my numbers from 1 to 50 or any other number
numberCount = 0
For j = 0 To UBound(friendsArray) 'my array of any size (in question said 150)
If i = friendsArray(j) Then
numberCount = numberCount + 1
End If
Next j
Select Case numberCount
Case 0
zeroString = zeroString & i & " - "
Case 1
oneString = oneString & i & " - "
Case 2
twoString = twoString & i & " - "
Case 3
threeString = threeString & i & " - "
Case 4
fourString = fourString & i & " - "
Case 5
fiveString = fiveString & i & " - "
Case Else
End Select
Next i

Answer 1

I have found possible option using Collection (but have got an headache with getting keys of collection...):
Dim col As New Collection
For i = 1 To totalNumbers
numberCount = 0
For j = 0 To UBound(friendsArray)
If i = friendsArray(j) Then
numberCount = numberCount + 1
End If
Next j
colValue = CStr(numberCount) & "> " & CStr(i) & " - " 'store current combination [key] and number as String
If IsMissing(col, CStr(numberCount)) Then
col.Add colValue, CStr(numberCount) 'if current combination of duplicates [key] is missing - add it to collection
Else 'if current combination [key] is already here - update the value [item]
oldValue = col(CStr(numberCount))
newValue = Replace(oldValue & colValue, CStr(numberCount) & "> ", "") 'delete combinations count
newValue = CStr(numberCount) & "> " & newValue
col.Remove CStr(numberCount) 'delete old value
col.Add newValue, CStr(numberCount) 'write new value with the same key
End If
Next i
For i = 1 To col.Count
Debug.Print col(i)
Next i
and IsMissing function (found here How to check the key is exists in collection or not)
Private Function IsMissing(col As Collection, field As String)
On Error GoTo IsMissingError
Dim val As Variant
val = col(field)
IsMissing = False
Exit Function
IsMissingError:
IsMissing = True
End Function
Output is like this [times]> [numbers]:
(array of 570 numbers)
114> 2 -
5> 6 -
17> 10 -
10> 3 - 8 - 19 - 21 - 30 -
6> 1 - 29 - 33 -
8> 5 - 9 - 13 - 23 - 25 - 28 - 37 - 40 -
4> 12 - 16 - 41 -
13> 43 -
12> 15 - 20 - 22 - 27 - 36 - 38 - 42 - 44 - 45 - 46 -
9> 4 - 7 - 11 - 14 - 34 - 47 - 48 -
7> 17 - 18 - 35 - 49 -
11> 24 - 26 - 31 - 32 - 39 - 50 -

Answer 2

Creating new array and count the number is more simple.
Sub test()
Dim friendsArray(0 To 50)
Dim vTable()
Dim iMax As Long
Dim a As Variant, b As Variant
Dim i As Long, s As Integer, n As Long
dim c As Integer
'Create Sample array to Test
n = UBound(friendsArray)
For i = 0 To n
friendsArray(i) = WorksheetFunction.RandBetween(0, 50)
Next i
'Your code
iMax = WorksheetFunction.Max(friendsArray)
ReDim vTable(0 To iMax) 'create new Array to count
For i = 0 To n
c = friendsArray(i)
vTable(c) = vTable(c) + 1
Next i
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
For i = 0 To iMax
If IsEmpty(vTable(i)) Then
s = 0
Else
s = vTable(i)
End If
If dic.Exists(s) Then
dic.Item(s) = dic.Item(s) & " - " & i
Else
dic.Add s, i
End If
Next i
a = dic.Keys
b = dic.Items
Range("a1").CurrentRegion.Clear
Range("B:B").NumberFormatLocal = "#"
Range("a1").Resize(UBound(a) + 1) = WorksheetFunction.Transpose(a)
Range("b1").Resize(UBound(b) + 1) = WorksheetFunction.Transpose(b)
Range("a1").CurrentRegion.Sort Range("a1"), xlAscending
End Sub