Excel concatenate macro help

P

Proteos

Gawd
Joined
May 28, 2008
Messages
656
I am not sure if anyone can help me with this on this forum but I thought I would give it a shot :D

I am trying to make a macro that will concatenate text on different rows based upon the values in another column. Let me give an example.

Column Column
A B
X Jim
X John
X Joe
Y Jake
Y Mike

So basically what I want the macro to do is concatenate the Values in column B that are all have similar values in Column A. The other issue would be that the range at which it would have to compare the values in Column A would be variable. Is this possible?
 
The only issue with that link you posted is that it explains how to concatenate with values that are lined up in a row, and therefore would not work for my use. I need to concatenate the data to show up as follows


A B C
X Jim Jim John Joe
X John
X Joe
Y Jake Jake Mike
Y Mike

So column C would contain all the contents of B that had a value of X in Column A, and all the Contents of B that contained Y in Column A.
 
This is a crude way of doing it in VBA:
Code: 
Sub CombineEm()
    Dim i As Integer, j As Integer
    Dim LastRow As Long
    Dim cellContents As String
    
    LastRow = Sheet1.Cells.Find(What:="*", _
      SearchDirection:=xlPrevious, _
      SearchOrder:=xlByRows).Row

    For i = 1 To LastRow
        cellContents = Sheet1.Cells(i, 3)
        
        If cellContents = "" Then ' check that this row hasn't been added to another
            cellContents = Sheet1.Cells(i, 2) & " "
            For j = i + 1 To LastRow ' find other matching rows
                If Sheet1.Cells(i, 1) = Sheet1.Cells(j, 1) Then
                    cellContents = cellContents & Sheet1.Cells(j, 2) & " "
                    Sheet1.Cells(j, 3) = "x" ' mark it to skip
                End If
            Next
            Sheet1.Cells(i, 3) = cellContents
        End If
    Next
End Sub
Your sample data would show this after running it:
Code: 
A B    C
X Jim  Jim John Joe
X John x
X Joe  x
Y Jake Jake Mike
Y Mike x

With a couple more lines, you could delete the rows that you're merging. Just remember to decrement the LastRow variable and switch the outer for loop to a do/while loop.
 
Thanks! is there any way you can make it check for duplicates in another column too? I just found out that there will be data from another column that will have duplicates in it with a good amount of space between the Column I had previously labeled A. Like so...
1 2 3 4 5 A B C
Z X Jim Jim John Joe
Z X John
Z X Joe
Z Y Jake Jake Mike
Z Y Mike

Columns 2-5 would have other data, but is not important to the concatenation.
 
Code: 
Sub CombineEm()
    Dim i As Integer, j As Integer
    Dim LastRow As Long
    Dim cellContents As String
    
    LastRow = Sheet1.Cells.Find(What:="*", _
      SearchDirection:=xlPrevious, _
      SearchOrder:=xlByRows).Row

    For i = 1 To LastRow
        cellContents = Sheet1.Cells(i, 3)
        
        If cellContents = "" Then ' check that this row hasn't been added to another
            cellContents = Sheet1.Cells(i, 2) & " "
            For j = i + 1 To LastRow ' find other matching rows
                If Sheet1.Cells(i, 1) = Sheet1.Cells(j, 1) Then
                    [color=red]If Instr(cellContents, Sheet1.Cells(j, 2)) < 0 Then [/color]cellContents = cellContents & Sheet1.Cells(j, 2) & " "
                    Sheet1.Cells(j, 3) = "x" ' mark it to skip
                End If
            Next
            Sheet1.Cells(i, 3) = cellContents
        End If
    Next
End Sub
The change testing for duplicates is made in red. It's just a simple test, so Jim would show as a duplicate for Jimmy if it was already found. Adding a space to the tested name would help (Instr(cellContents, Sheet1.Cells(j, 2) & " ")), but there may be other cases where the test would fail (JoAnna & Anna, for example, or if the names only differ by case... use LCase before testing each). I'm also too lazy to convert it to an array and test that way. :p

You need to change the references Sheet1.Cells(x, y) above. y = 1 for column A, y = 2 for column B, etc. The Sheet1 reference should also match the sheet name.
 
I want to thank you immensely. Thank you very much for your help!

The only problem I have is I cannot seem to get the second macro that you posted to work.

I have a more exact example now if this will help at all. Let me try to represent it now...

B E F
1 BG X
1 BG Y
1 EN T
1 EN V
2 BG U
2 BG I
2 EN O
2 EN P

So essentially I need the macro to combine the information in column F if B is a 1 and E is a BG, etc. Columns A,C, and D all contain data that is not relevant. Also, none of the data starts until row 6.

Sorry if I am not following what you have posted... I just recently taught myself the basics of VBA so some of this is over my head :D
 
You must log in or register to reply here.
Back
Top