"Dave Peterson" wrote...
Maybe something like:

Option Explicit
Function myJoin(rng As Range) As String
....
For Each myCell In rng.Cells
....

Load NoDupes collection

myStr = ""
If NoDupes.Count 0 Then
'Sort the collection
For i = 1 To NoDupes.Count - 1
....

Bubble sort it.

For i = 1 To NoDupes.Count
HowMany = Application.CountIf(rng, NoDupes(i))
....

Use COUNTIF to count multiple instances.

This iterates through the range more than is necessary. Collection objects
can be used to greater effect.


Option Explicit
Option Compare Text
Function foo(r As Range) As String
Dim s As String, u As String, k As Long, x As Variant
Dim c As New Collection, d As New Collection

On Error Resume Next

'load collection c containing 1st instance of each key and its count
For Each x In r
s = x.Value
u = UCase(s)

If u < "" Then
Call c.Item(u) 'will throw an error if u not yet in c

If Err.Number < 0 Then '1st instance
c.Add Item:=Array(s, 1), Key:=u
Err.Clear

Else 'duplicate instance - note: use letter case of 1st instance
s = c.Item(u)(0)
k = c.Item(u)(1) + 1
c.Remove Index:=u
c.Add Item:=Array(s, k), Key:=u

End If

End If

Next x

'put c's sorted keys into collection d - still bubble sort
For Each x In c
For k = 1 To d.Count
If x(0) < d.Item(k) Then
d.Add Item:=x(0), befo=k
Exit For 'ensures 1 <= k <= d.count
End If
Next k

If d.Count = 0 Then '1st item
d.Add Item:=x(0)
ElseIf k d.Count Then 'new last item
d.Add Item:=x(0), after:=d.Count
End If

Next x


'generate result
For Each x In d
foo = foo & ", " & c.Item(x)(0)
k = c.Item(x)(1)
If k 1 Then foo = foo & Format(k, "\(0\)")
Next x

foo = Mid(foo, 3)
End Function