Alternative to the newer dynamic array functions
Loving the above nice solutions it's always a challenge to think over additional approaches (via Byte array, Filter() and FilterXML() function):
Function UniqueDigits(ByVal txt) As String
Dim by() As Byte: by = txt
Dim digits: digits = Array(49, 50, 51, 52, 53, 54, 55, 56, 57, 48, 0) ' equalling Asc values
'a) create 1-based 1-dim array with digit positions
Dim tmp: tmp = Filter(Application.Match(by, digits, 0), 11, False)
'b) get uniques
tmp = Uniques(tmp)
'c) sort it (don't execute before getting uniques)
BubbleSort tmp
'd) return function result
UniqueDigits = Join(tmp, "")
End Function
Function Uniques(arr)
'Note: using FilterXML() available since vers. 2013+
Dim content As String ' replacing "10" referring to zero indexed as 10th digit
content = Replace("<t><s>" & Join(arr, "</s><s>") & "</s></t>", "10", "0")
arr = WorksheetFunction.FilterXML(content, "//s[not(preceding::*=.)]")
Uniques = Application.Transpose(arr)
End Function
Sub BubbleSort(arr)
Dim cnt As Long, nxt As Long, temp
For cnt = LBound(arr) To UBound(arr) - 1
For nxt = cnt + 1 To UBound(arr)
If arr(cnt) > arr(nxt) Then
temp = arr(cnt)
arr(cnt) = arr(nxt)
arr(nxt) = temp
End If
Next nxt
Next cnt
End Sub
Further hints :-) tl;dr
...explaining
a) how to transform a string to a digits array,
b) how to get uniques via FilterXML instead of a dictionary
c) (executing BubbleSort needs no further explanation).
ad a) the tricky way to get a pure digits array
Transforming a string of digits into an array of single characters may need some explanation.
- A string (here
txt) can assigned easily to a byte array via Dim by() As Byte: by = txt. (Note that classical characters would be represented in a byte array by a pair of Asc values, where the second value mostly
is 0; so digit 1 is represented by 49 and 0, 2 by 50 and 0 up to 9 by 57 and 0).
Digits are defined in a 1-based Asc value array from 1~>49 to 9~>57, followed by the 10th item 0~>48 and
eventually the Asc value 0 as 11th item related to each second byte pair.
Dim digits: digits = Array(49, 50, 51, 52, 53, 54, 55, 56, 57, 48, 0) ' equalling Asc values
- Usually the
Match() function searches for a specified item in order to get its relative position within an array (here digits) and would be executed by the following syntax: ``.
MATCH(lookup_value, lookup_array, [match_type])
where the lookup_value argument can be a value (number, text, or logical value) or a cell reference to a number, text, or logical value.
An undocumented feature is that instead searching e.g. 2 in the lookup_array digits via
Application.Match(2, digits,0) you can use the byte array as first argument serving as 1-based array pattern where VBA replaces the current Asc values by their position found within the digits array.
Application.Match(by, digits, 0)
Finally a negative filtering removes the companion Asc 0 values (11 plus argument False) via
Dim tmp: tmp = Filter(Application.Match(by, digits, 0), 11, False)
ad b) get uniques via FilterXML
Help reference for the WorksheetFunction.FilterXML method demands two string parameters
FilterXML(XMLContentString, XPathQueryString)
The first argument doesn't reference a file, but needs a valid ("wellformed") XML text string starting with a root node (DocumentElement) which is roughly comparable to a html structure starting with the enclosing pair of <html>...</html> tags.
So a wellformed content string representing e.g. number 121 could be:
<t>
<s>1</s>
<s>2</s>
<s>1</s>
</t>
The second argument (limited to 1024 characters) must be a valid XPath query string like the following find non-duplicates
"//s[not(preceding::*=.)]"
where the double slash // allows to find s nodes at any hierarchy level and under the condition that it is not
preceded by any nodes * with the same value content =.
Recommended readings
@RonRosenfeld is a pioneer author of numerous answers covering the FilterXML method, such as e.g. Split string cell....
@JvDV wrote a nearly encyclopaedic overview at Extract substrings from string using FilterXML.
