A fellow struggler requested me to help him with a slightly beefed up Range Concatenate function. He needed to combine a bunch of numbers in a range; there were multiple entries of the same number, and he wanted a unique list; finally he needed to format the numbers.
I was thinking about using a Dictionary Object, to get a unique list before concatenating. However, the fellow struggler provided me with a function that he already found on the web, and asked me to tweak it for the formatting part. The author used the InStr() function to check if the value has already been added to the result before concatenating. I hated myself for not having thought of that, I ditched my unique list idea, and went with the InStr() method.
This is what I came up with:
'================================================================== 'ConcatenateUnique '================================================================== 'Function to Concatenate only unique values in a range, with 'an optional formatting string. If it's not specified, the 'values will be treated as string ("@"). This function inserts 'a separator string between each value, and it is set to " " 'by default '================================================================== 'Date : 18 February 2014 'Website : https://strugglingtoexcel.wordpress.com/ 'Email : StrugglingToExcel@outlook.com '================================================================== Function ConcatenateUnique(ByRef WhichRange As Range, _ Optional ByVal Seperator As String = " ", _ Optional ByVal Format As String = "@", _ Optional ByVal CaseSensitive As Boolean = False) _ As String Dim rngEach As Range 'Range Object - For Loop Dim strAnswer As String 'String Variable - End Answer Dim strTemp As String 'String Variable - Store Cell Value Dim CompMethod As VbCompareMethod 'Set the TextCompare Method for the Instr() function If CaseSensitive Then CompMethod = vbBinaryCompare Else CompMethod = vbTextCompare End If For Each rngEach In WhichRange strTemp = rngEach.Value 'Process only if the cell is not blank If Not strTemp = vbNullString Then 'Apply the formatting strTemp = Application.WorksheetFunction.Text(strTemp, Format) 'Initialize the Final String first, then concatenate If strAnswer = vbNullString Then strAnswer = strTemp Else 'Concatenate only if unique If InStr(1, Seperator & strAnswer & Seperator, _ Seperator & strTemp & Seperator, _ CompMethod) = 0 Then strAnswer = strAnswer & Seperator & strTemp End If End If End If Next rngEach 'Return the Final String ConcatenateUnique = strAnswer End Function