Forum Discussion

tompaskinrobbins's avatar
tompaskinrobbins
Copper Contributor
Mar 27, 2018

Combine text from multiple sequential rows by column to the left

I am trying to combine text that has been split across multiple rows, but to match the column to the left. 

 

Below is an excel table example to illustrate the problem. I want to be able to combine the text in the column to the right so that 'text needs to be merged' is combined in one cell to align with column '1'. As in the second table. 

 

I need to combine text in this way across thousands of rows of data (>23,000 rows). But the there is no pattern to the data. e.g. different number of rows to each column to the left each time.

 

And there is no pattern in terms of text content of each column to the left. Some may repeat text (may have the same text in multiple columns to the left), but I want to preserve the sequential order of the columns and rows, not sort by content.

 

Please could someone advise on a way I could perform this function in excel?

 

1st table: this is a simplified example of what the data looks like now in excel...

 

1 Text
needs
to
be
combined
2 but 
each word
kept.
3 please can
someone
advise

 

Second table: this is what i need it to look like in excel...

 

Formulas & Functions
tips and tricks
  • Matt Mickle's avatar
    Matt Mickle
    Bronze Contributor
    Apr 01, 2018

    Try using this code to accomplish your task (I have commented for better understanding).  The code works using your example data:

     

    Sub Test()

Dim Lrow As Long
Dim LngLp As Long
Dim TXT As String
Dim Flag As Boolean

'Supress Pop Up Alerts
Application.DisplayAlerts = False

'Define Last Row based on column B
Lrow = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row
1
'UnMerge All Cells
ActiveSheet.Cells.UnMerge

'Loop through Values
For LngLp = 1 To Lrow
    If ActiveSheet.Cells(LngLp, "A") <> "" Then 'Test for value
       If Flag = True Then
            ActiveSheet.Range(Cells(Counter, "B"), Cells(LngLp - 1, "B")).Merge 'Merge Cells
            ActiveSheet.Range(Cells(Counter, "A"), Cells(LngLp - 1, "A")).Merge 'Merge Cells
            ActiveSheet.Cells(Counter, "B") = Mid(TXT, 1, Len(TXT) - 1) 'Chop of Extra Space
            LngLp = LngLp - 1 'Change counter so it's at the right row
            Flag = False 'Reset Start Flag
            TXT = vbNullString 'Reset
            GoTo NextSection
       End If
       TXT = TXT & ActiveSheet.Cells(LngLp, "B") & " " 'Concatenate Text Strings
       Flag = True 'Set Start Flag
       Counter = LngLp 'Set Start Row
    Else
        TXT = TXT & ActiveSheet.Cells(LngLp, "B") & " " 'Concatenate Text Strings
    End If
NextSection:
'Handle Last Merged Cells
If LngLp = Lrow Then
     ActiveSheet.Range(Cells(Counter, "B"), Cells(LngLp, "B")).Merge 'Merge Cells
    ActiveSheet.Range(Cells(Counter, "A"), Cells(LngLp, "A")).Merge 'Merge Cells
    ActiveSheet.Cells(Counter, "B") = Mid(TXT, 1, Len(TXT) - 1) 'Chop of Extra Space
End If

Next LngLp
'Turn Pop Up Alerts Back On
Application.DisplayAlerts = False
End Sub

     

    It should be noted that merged cells are usually frowned upon.  You can use border formatting as well as indentions to accomplish something similar.... 

Resources