Concatenate Unique Cells, with Text Formatting


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
Advertisements

7 thoughts on “Concatenate Unique Cells, with Text Formatting

  1. Nice solution however it’s not bulletproof.
    Let’s take a short example:
    I want to concatenate all unique values from list below
    – aaab
    – bbb
    – ccc
    – aaa
    – bbb

    Instead of “aaab bbb ccc aaa” you will get “aaab bbb ccc”. Value “aaa” will be ignored because it will be found inside “aaab”.
    That is why you should use Dictionary object.

    I also suggest you to loop on arrays instead of range – it’s faster.
    Here you can see how I would write this function:

    Like

    • Hi Lukasz, I agree with you, Dictionary object was my first instinct too, as soon as I heard the word “Unique”. However, this function was targeted at concatenating ID numbers (hence the formatting option).

      But I do have a quick fix for the problem – Search for in – that way it will become bullet proof. Ill amend the code now.

      As for the Arrays, I initially thought I’d extract the number formatting string from the cell instead of taking it as an input: applica…worksheetfunc…text(cell.vallue,cell.numberformat) – but later decided to take it as an input.

      I like your code. I see that you do not prefer the on error resume next statement – using the exist method instead.

      And thanks a lot for introducing me to the iif() and Join() functions. I did not know they existed in VB. I think they alone deserve separate posts. Can’t believe that this is the first time I am hearing of it. Thanks for taking the time to help a fellow struggler!

      Like

      • Hi,

        There is no point in using “on error resume next” when you are working with Dictionary object, especially when you know that Exists() method is faster. It is allways better to use build-in object features than making your own workaround.

        Catching/ignoring erros are good when you use Collections, just because it’s the only way to find out whether Key exists in it or not.

        In regards to Iff() and Join() functions – I agree with you, they are robust.
        IFF() is very helpfull when you have to set many variables based on some conditions.
        Of course we also can write:
        If condition Then: value_if_true: Else:value_if_false:EndIf
        But I think that Iff() looks better and it’s more readable.

        Anyway, I’m glad that I showed you something new.

        Like

        • One of the reasons I created this blog was to get feedback from experienced VBA programmers. Looks like its happening now. Thanks Lukasz! I hope you find the time to check up on me once in a while. I will follow your stuff on github!

          Like

If you liked it, let me know. If you didn't make sure you let me know!

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s