View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.misc
[email protected] adam_kroger@hotmail.com is offline
external usenet poster
 
Posts: 20
Default UDF to Count, but delete duplicate entries in a range using Excel2003

Thank You, it works great

On Jul 23, 1:50 pm, Dave Peterson wrote:
Maybe something like:

Option Explicit
Function myJoin(rng As Range) As String

'unique list and sorting taken from:
'http://j-walk.com/ss/excel/tips/tip47.htm

Dim NoDupes As Collection
Dim myCell As Range
Dim i As Long
Dim j As Long
Dim Swap1 As Variant
Dim Swap2 As Variant
Dim myStr As String
Dim HowMany As Long
Dim ThisElement As String

Set NoDupes = New Collection

For Each myCell In rng.Cells
If myCell.Value = "" Then
'skip it
Else
On Error Resume Next
NoDupes.Add Item:=myCell.Value, key:=CStr(myCell.Value)
On Error GoTo 0
End If
Next myCell

myStr = ""
If NoDupes.Count 0 Then
'Sort the collection
For i = 1 To NoDupes.Count - 1
For j = i + 1 To NoDupes.Count
If lCase(NoDupes(i)) lCase(NoDupes(j)) Then
Swap1 = NoDupes(i)
Swap2 = NoDupes(j)
NoDupes.Add Swap1, befo=j
NoDupes.Add Swap2, befo=i
NoDupes.Remove i + 1
NoDupes.Remove j + 1
End If
Next j
Next i

For i = 1 To NoDupes.Count
HowMany = Application.CountIf(rng, NoDupes(i))
If HowMany 1 Then
ThisElement = NoDupes(i) & " (" & HowMany & ")"
Else
ThisElement = NoDupes(i)
End If
myStr = myStr & ", " & ThisElement
Next i

If myStr < "" Then
myStr = Mid(myStr, 3)
End If

End If

myJoin = myStr

End Function





wrote:

--Given--
_________________________
A B C D
1 Fred Fred
2 apple red
3 red blue
4 now
_________________________


I am using a UDF to return the value:
"Fred Fred apple red red blue now"
I would like to have:
"Fred(2) apple red(2) blue now" <--- duplicate entries counted
but removed
Or even better:
"apple, blue, Fred(2), now, red(2)" <---Alphabatized with commas
between the entries


Ideally it would even ignore variations in capitalization (FrEd = fred
= Fred) and report everything in ALL CAPS.


This is the VBA as it is now:
------------------------------------------------------------------
Function join_function(MyRng As Range)
Dim MyCell As Range
Dim output As String
For Each MyCell In MyRng
Found = False
If Application.WorksheetFunction.IsText(MyCell) = True Then
output = output & MyCell.Value & " "
End If
Next
join_function = output


End Function
------------------------------------------------------------------
and I am calling it from inside a cell like this:
=join_function(A1:D4) or =join_function(NamedRange)
***
The function is used in an activity tracking WorkBook that has 4
cells labeled "OTHER" for each day. It is used to produces Weekly,
Quarterly, Semi-Annual, and Annual totals for 12 employees (each
employee has a seperate sheet). These summaries are retreived via an
INDEX(MATCH()) on another worksheet and reported by a MsgBox from a
command button.


I can live with it the way it is now, but... well... we all always
want more :)


--

Dave Peterson- Hide quoted text -

- Show quoted text -