View Single Post
  #10   Report Post  
Posted to microsoft.public.excel.worksheet.functions
Tabby Tabby is offline
external usenet poster
 
Posts: 5
Default Repeating numbers in same cell

WOW! All of that just to fix somebody's boo-boo? I'll give it a try. As I
don't understand any of this, I'm skeptical that I will succeed.

Thanks to all of you for your assistance.

Tess

"Ron Rosenfeld" wrote:

On Fri, 4 Apr 2008 08:20:01 -0700, Tabby
wrote:

I have a worksheet that has repeating numbers in one cell.
Example: 1204,1205,1206,1205,1204

Is there a formula that will total the repeating numbers? i.e. (2) 1204,
(2) 1205?


I misread your initial request.

This UDF will return a sorted horizontal array consisting of the list of
numbers in row 1, and the count for each number in row two.

You can return the values on your worksheet in a variety of ways.

You could enter this array formula in two adjacent columns, with dimensions
large enough to include all of the unique values:

=TRANSPOSE(UniqueNums(A1)))

(gives you a vertical array; without the TRANSPOSE you'd have a horizontal
array).

With your data in A1

B1: =INDEX(UniqueNums($A$1),1,ROWS($1:1))
C1: =INDEX(UniqueNums($A$1),2,ROWS($1:1))

and fill down as far as required. (With LOTS of data, this method may take a
while to run).

There are other solutions, based on this algorithm, that may be appropriate
depending on more specifics.

Also, I'm not sure how you want the results sorted. As posted, it will sort by
the most frequent to the least frequent value. If you just want the results
sorted in numerical order, comment out the second Bubblesort line in the first
procedure.


Here is the code. Enter it into a regular module as I posted previously.

===========================================
Option Explicit
Function UniqueNums(CSN As String)
'Returns a horizontal two dimensional
' array of unique words and count
Dim cNumList As Collection
Dim Str
Dim sRes() As Variant
Dim I As Long, J As Long

'Split string
Str = Split(CSN, ",")

'get list of unique words
Set cNumList = New Collection

On Error Resume Next
For I = 0 To UBound(Str)
cNumList.Add Str(I), Str(I)
Next I
On Error GoTo 0

ReDim sRes(0 To 1, 1 To cNumList.Count)
For I = 1 To cNumList.Count
sRes(0, I) = cNumList(I)
Next I

'get number count for each number
For I = 1 To UBound(sRes, 2)
sRes(1, I) = (Len(CSN) - Len(Replace(CSN, sRes(0, I), ""))) / Len(sRes(0,
I))
Next I


'Sort Numerically Ascending
BubbleSort sRes, 0, True

'then sort by Count highest to lowest
BubbleSort sRes, 1, False

UniqueNums = sRes
End Function
'--------------------------------------------------------------
Private Sub BubbleSort(TempArray As Variant, d As Long, _
bSortDirection As Boolean)
'bSortDirection = True means sort ascending
'bSortDirection = False means sort descending
Dim Temp1 As Variant, Temp2
Dim I As Long
Dim NoExchanges As Boolean
Dim Exchange As Boolean

' Loop until no more "exchanges" are made.
Do
NoExchanges = True

' Loop through each element in the array.
For I = 1 To UBound(TempArray, 2) - 1

' If the element is greater/less than the element
' following it, exchange the two elements.

Exchange = TempArray(d, I) < TempArray(d, I + 1)
If bSortDirection = True Then Exchange = _
TempArray(d, I) TempArray(d, I + 1)
If Exchange Then
NoExchanges = False
Temp1 = TempArray(0, I)
Temp2 = TempArray(1, I)
TempArray(0, I) = TempArray(0, I + 1)
TempArray(1, I) = TempArray(1, I + 1)
TempArray(0, I + 1) = Temp1
TempArray(1, I + 1) = Temp2
End If
Next I
Loop While Not (NoExchanges)
End Sub
==============================================
--ron