Chip Pearson's DistinctValues function

  • Thread starter Thread starter Mike Fogleman
  • Start date Start date
M

Mike Fogleman

BTW, Chip's site is throwing an error right now.

How can I get the array of distinct values results into a single cell
delimited with a comma?

InputRange
A2| E01AB
A3| E01AB
A4| E01CD
A5| A11

Output
AE15| E01AB,E01CD,A11

The input and output ranges will be determined with VB.
Mike F
 
Dear Mike

Launch VBE using Alt+F11, Insert module and paste the below function. Access
this under UserDefined functions.

Function GetDistinctValueString(varRange As String)
Dim varCell As Range
For Each varCell In Range(varRange)
If InStr(strTemp & ",", "," & varCell.Text & ",") = 0 Then
GetDistinctValueString = GetDistinctValueString & "," & varCell.Text
End If
Next
GetDistinctValueString = Mid(GetDistinctValueString, 2)
End Function

If this post helps click Yes
 
Mike,

The site is back up and running.

Create a VBA function as follows:

Public Function Join(Arr As Variant, Sep As String) As String
Join = VBA.Join(Arr, Sep)
End Function

Then, in a worksheet cell, use the following formula:

=Join(DistinctValues(A1:A5,TRUE),",")

Cordially,
Chip Pearson
Microsoft Most Valuable Professional
Excel Product Group, 1998 - 2009
Pearson Software Consulting, LLC
www.cpearson.com
(email on web site)
 
Oops, a small mistake.. Try this

Function GetDistinctValueString(varRange As String)
Dim varCell As Range
For Each varCell In Range(varRange)
If InStr(GetDistinctValueString & ",", "," & varCell.Text & ",") = 0 Then
GetDistinctValueString = GetDistinctValueString & "," & varCell.Text
End If
Next
GetDistinctValueString = Mid(GetDistinctValueString, 2)
End Function

If this post helps click Yes
 
How would I incorporate your 2 functions in this routine?

Sub Test()
Dim InputRange As Range
Dim ResultArray As Variant
Dim Ndx As Long

Set InputRange = Range("InputValues")
ResultArray = DistinctValues(InputValues:=InputRange, IgnoreCase:=True)
'calls Chip's DistinctValues function
If IsArray(ResultArray) = True Then
For Ndx = LBound(ResultArray) To UBound(ResultArray)
Range("J" & Ndx).Value = ResultArray(Ndx)
'Debug.Print ResultArray(Ndx)
Next Ndx
Else
If IsError(ResultArray) = True Then
Debug.Print "ERROR: " & CStr(ResultArray)
Else
Debug.Print "UNEXPECTED RESULT: " & CStr(ResultArray)
End If
End If
End Sub

Mike F
 
Thanks Chip, works perfect:

Public Function Join(Arr As Variant, Sep As String) As String
'joins ResultArray into single cell
Join = VBA.Join(Arr, Sep)
End Function

Sub Test2()
Dim InputRange As Range
Dim ResultArray As Variant
Dim Ndx As Long

Set InputRange = Range("InputValues")
ResultArray = DistinctValues(InputValues:=InputRange, IgnoreCase:=True)
'Join(DistinctValues(A1:A5,TRUE),",")
If IsArray(ResultArray) = True Then
Range("J1").Value = Join(DistinctValues(InputRange, True), ", ")
'Debug.Print ResultArray(Ndx)
Else
If IsError(ResultArray) = True Then
Debug.Print "ERROR: " & CStr(ResultArray)
Else
Debug.Print "UNEXPECTED RESULT: " & CStr(ResultArray)
End If
End If
End Sub

Mike F
 
I think you can significantly simplify your code. First of all, you're
calling the DistinctValues function twice, which an lead to
performance problems if the input range is large.

Try code like

Sub AAA()
Dim InputRange As Range
Dim Vals As Variant
Set InputRange = Range("A1:A5")
Vals = DistinctValues(InputRange, True)
If IsArray(Vals) = True Then
Range("J1").Value = Join(Vals, ",")
End If
End Sub


Cordially,
Chip Pearson
Microsoft Most Valuable Professional
Excel Product Group, 1998 - 2009
Pearson Software Consulting, LLC
www.cpearson.com
(email on web site)
 
The input range would not exceed 7 rows at a time, however, in the course of
creating my report, there would be many input ranges numbering several
hundred. I will use this to avoid calling the function twice.
Thanks, Mike F
 
Back
Top