Reverse Concatenation

[TBRoberts]

The question is of reverse concatenation in Excel VBA.


I currently have this:

Joe, Jon

Joe, Pam, Carl

Joe, Jon, Jeremy

<tbody>
</tbody>

And need to reverse concatenate so I can then have each individual name in its own row and cell as follows:

Joe

Jon

Joe

Pam

Carl

Joe

Jon

Jeremy

<tbody>
</tbody>

I can then remove the duplicate names and re-concatenate to have the following:

Joe, Jon, Pam, Carl, Jeremy

<tbody>
</tbody>

Please note that the data is not static and so the number of individuals/rows will change.

I won't need any button or msgbox for this code but comments before each action would be great to help me understand what is going on within your coding.

Thank you!

 

[Rick Rothstein]

Here is a UDF (user defined function) that will return your concatenated unique values directly (delimiter is assumed to be a comma followed by a space)...

Function Uniques(Rng As Range) As String
  Dim Cell As Range, V As Variant, Data() As String
  Const Delimiter As String = ", "
  With CreateObject("Scripting.Dictionary")
    For Each Cell In Rng
      For Each V In Split(Cell.Value, Delimiter)
        .Item(V) = 1
      Next
    Next
    Uniques = Join(.Keys, Delimiter)
  End With
End Function

HOW TO INSTALL UDFs
------------------------------------
If you are new to UDFs, they are easy to install and use. To install it, simply press ALT+F11 to go into the VB editor and, once there, click Insert/Module on its menu bar, then copy/paste the above code into the code window that just opened up. That's it.... you are done. You can now use Uniques just like it was a built-in Excel function. For example,

=Uniques(A1:A3)

If you are using XL2007 or above, make sure you save your file as an "Excel Macro-Enabled Workbook (*.xlsm) and answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

 

[TBRoberts]

Hey Rick, thanks for the reply. This will be a small piece of a larger macro and the function would not be used on its own. If possible, I would just like to loop through the whole column from top to bottom and insert the end result into a new cell. I am also getting a #Name ? error with the code posted above. I am using 2013 and I tested in .xlsm (macros are enabled).

 

[Rick Rothstein]

Hey Rick, thanks for the reply. This will be a small piece of a larger macro and the function would not be used on its own. If possible, I would just like to loop through the whole column from top to bottom and insert the end result into a new cell. I am also getting a #Name ? error with the code posted above. I am using 2013 and I tested in .xlsm (macros are enabled).

Show me the code you are using.

I would also note that you can have your code call my function directly and physically place the result into whatever cell you need it to go into.

 

[TBRoberts]

Scratch that, I didnt save the macro in the correct project location and it does indeed work as a function. Would i be able to use this in a loop within VBA now for a dynamic range? That way the user does not have to specify the range each time.

 

[Rick Rothstein]

Scratch that, I didnt save the macro in the correct project location and it does indeed work as a function. Would i be able to use this in a loop within VBA now for a dynamic range? That way the user does not have to specify the range each time.

The function, as written, requires a range to be passed into it. What do you mean by "dynamic range"? Are you writing a macro or event code?

 

[TBRoberts]

Dim LastRow As LongDim CaseNumbers As String
Dim AccountNumbers As String
Dim d As Object, c As Variant, i As Long
Dim s As String, r As Range, x As Intege


'Extracting Case #'s




Set d = CreateObject("Scripting.Dictionary")
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
c = Range("A4:A" & LastRow)
For i = 1 To UBound(c, 1)
  d(c(i, 1)) = 1
Next i
Range("B" & LastRow + 2).Resize(d.Count) = Application.Transpose(d.Keys)




'Concatenating case #'s






LastRow = Cells(Rows.Count, "A").End(xlUp).Row


Range("B" & LastRow + 2).Activate


x = Range("B" & LastRow + 2).CurrentRegion.Rows.Count


For Each r In ActiveCell.Resize(x, 1)
    CaseNumbers = CaseNumbers & r.Value & ", "
Next r


CaseNumbers = Left(CaseNumbers, Len(CaseNumbers) - 2)


Range("b" & LastRow + 2).Value = CaseNumbers


ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xldown)).Select


Selection.Delete


Range("a" & LastRow + 2).Value = "Case Number(s):"




'Extracting Account #'s




Set d = CreateObject("Scripting.Dictionary")
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
c = Range("D4:D" & LastRow)
For i = 1 To UBound(c, 1)
  d(c(i, 1)) = 1
Next i
Range("B" & LastRow + 2).Resize(d.Count) = Application.Transpose(d.Keys)
Range("A" & LastRow + 2).Value = "Account Number(s):"






'Concatenating Account #'s






LastRow = Cells(Rows.Count, "A").End(xlUp).Row


Range("B" & LastRow).Activate


x = Range("B" & LastRow).CurrentRegion.Rows.Count


For Each r In ActiveCell.Resize(x, 1)
    AccountNumbers = AccountNumbers & r.Value & ", "
Next r




Range("B" & LastRow).Value = AccountNumbers


AccountNumbers = Left(AccountNumbers, Len(AccountNumbers) - 2)


ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xldown)).Select


Selection.Delete




'Extracting Client names










End Sub

 

[TBRoberts]

I will post a table for reference

 

[TBRoberts]

CASE # <tbody> </tbody>	SCENARIO <tbody> </tbody>	CLIENT <tbody> </tbody>	ACCOUNT NUMBER <tbody> </tbody>	Date <tbody> </tbody>	TRXN TYPE <tbody> </tbody>	AMOUNT <tbody> </tbody>	CREDIT / DEBIT <tbody> </tbody>
123456 <tbody> </tbody>	xxx <tbody> </tbody>	Joe, Jon <tbody> </tbody>	321321 <tbody> </tbody>	12/18/2017 <tbody> </tbody>	Transfer <tbody> </tbody>	$1.00 <tbody> </tbody>	D
123456 <tbody> </tbody>	xxx <tbody> </tbody>	Joe, Pam, Carl <tbody> </tbody>	321325 <tbody> </tbody>	12/18/2017 <tbody> </tbody>	Transfer <tbody> </tbody>	$2.00 <tbody> </tbody>	D
1234567 <tbody> </tbody>	xxx <tbody> </tbody>	Joe, Jon, Jeremy <tbody> </tbody>	321368 <tbody> </tbody>	12/18/2017 <tbody> </tbody>	Transfer <tbody> </tbody>	$3.00 <tbody> </tbody>	D

<tbody>
</tbody>

 

[TBRoberts]

The Case Numbers and Account Numbers were easy enough to extract and concatenate as they have a designated cell for each value. However, the Client names can be grouped together at times, and changes for each report ran. So i would need your function to basically loop through from top to bottom as the number of rows/clients will change for each report.