combine/merge row cells text between blank rows

wapo

New Member
Joined
Jun 14, 2009
Messages
3
Wondering if someone could help with the following problem. I have a large list of text in one column which i need to combine between blank rows into one cell or a new column, the number of rows to be combined varies. for example

aa
bb

ww
xx
zz

rr

gg
hh
ii
jj


would become

aa bb
ww xx zz
rr
gg hh ii jj

I have over 30000 lines so doing it by hand is not an option.
Thanks for any help or suggestions.
 

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple
Hi wapo,

Welcome to the board.

Might not be the most efficient way of doing it, but post back re how the following goes (just adjust any of the variables I've noted accordingly):

Code:
Sub Macro1()

Dim lngLastRow As Long
Dim lngConcatenateRow As Long
Dim strConcatenateCol As String
Dim strMyConcatenateString As String

    'Assumes the data and its last row can be found from Column A _
    - change if required.
    lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
    'Starting row to concatenate data _
    - change if required.
    lngConcatenateRow = 2
    
    'Column to concatenate data _
    - change if required.
    strConcatenateCol = "B"
    
    Application.ScreenUpdating = False
    
    For Each cell In Range("A2:A" & lngLastRow)
        If Len(cell) > 0 Then
            If strMyConcatenateString = "" Then
                strMyConcatenateString = cell.Value
            Else
                strMyConcatenateString = strMyConcatenateString & " " & cell.Value
            End If
        Else
            Range(strConcatenateCol & lngConcatenateRow).Value = _
                strMyConcatenateString
        strMyConcatenateString = ""
        lngConcatenateRow = lngConcatenateRow + 1
        End If
    Next cell
    
    If Len(strMyConcatenateString) > 0 Then
        Range(strConcatenateCol & lngConcatenateRow).Value = _
            strMyConcatenateString
    End If
    
    Application.ScreenUpdating = True
    
End Sub

HTH

Robert
 
Upvote 0
This is certainly not the "cleanest" solution, but it works.
With your column of data beginning in A2, place this formula
into B2 and copy down. =IF(ISBLANK(A2),"",B1&" "&A2)
Then in cell C2, place this formula: =IF(LEN(B3)=0,B2,"")
and copy down.
This column C will then give you your results. You may then
autofilter on column C for all non-blank values, then Edit |
Go To | Special | Visible cells only, then Edit | Copy, and then in
another sheet, Edit | Paste.
As I said, its "ugly" but it will do the job. Anyone else?
Larry.
 
Upvote 0
wapo,

Before the macro:


Excel Workbook
AB
1aa
2bb
3
4ww
5xx
6zz
7
8rr
9
10gg
11hh
12ii
13jj
14
Sheet1



After the macro:


Excel Workbook
AB
1aaaa bb
2bbww xx zz
3rr
4wwgg hh ii jj
5xx
6zz
7
8rr
9
10gg
11hh
12ii
13jj
14
Sheet1




Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Adding the Macro
1. Copy the below macro, by highlighting the macro code and pressing the keys CTRL+C
2. Open your workbook
3. Press the keys ALT+F11 to open the Visual Basic Editor
4. Press the keys ALT+I to activate the Insert menu
5. Press M to insert a Standard Module
6. Paste the code by pressing the keys CTRL+V
7. Press the keys ALT+Q to exit the Editor, and return to Excel.

Code:
Option Explicit
Sub CombineText()
Dim LR As Long, SR As Long, ER As Long, NR As Long, a As Long, Hold As String
Application.ScreenUpdating = False
SR = 1: NR = 1: Hold = ""
LR = Cells(Rows.Count, 1).End(xlUp).Row
Do Until SR = Rows.Count
  For a = SR To LR + 1 Step 1
    If Cells(a, 1) <> "" Then
      Hold = Hold & Cells(a, 1) & " "
    Else
      ER = a - 1
      Exit For
    End If
  Next a
  If Right(Hold, 1) = " " Then
    Hold = Left(Hold, Len(Hold) - 1)
  End If
  Cells(NR, 2) = Hold
  Hold = ""
  NR = NR + 1
  SR = Cells(ER, 1).End(xlDown).Row
Loop
Application.ScreenUpdating = True
End Sub


Then run the "CombineText" macro.
 
Upvote 0
wapo,

Welcome to the MrExcel board.


This should be faster (same screenshots as above).


Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Adding the Macro
1. Copy the below macro, by highlighting the macro code and pressing the keys CTRL+C
2. Open your workbook
3. Press the keys ALT+F11 to open the Visual Basic Editor
4. Press the keys ALT+I to activate the Insert menu
5. Press M to insert a Standard Module
6. Paste the code by pressing the keys CTRL+V
7. Press the keys ALT+Q to exit the Editor, and return to Excel.

Code:
Option Explicit
Sub CombineText()
Dim LR As Long, NR As Long, Hold As String, c As Range
Application.ScreenUpdating = False
NR = 1: Hold = ""
LR = Cells(Rows.Count, 1).End(xlUp).Row
For Each c In Range("A1:A" & LR + 1)
  If c <> "" Then
    Hold = Hold & c.Value & " "
  ElseIf c = "" Then
    If Right(Hold, 1) = " " Then
      Hold = Left(Hold, Len(Hold) - 1)
    End If
    Cells(NR, 2) = Hold
    Hold = ""
    NR = NR + 1
  End If
Next c
Application.ScreenUpdating = True
End Sub


Then run the "CombineText" macro.
 
Upvote 0
Thanks for the welcome and really quick responses, these solutions work really well.
One modification if its possible.
If i have data in columns to the right is it possible to keep that data aligned with the combined rows. Sorry I forgot to mention this, if its not possible the solutions have been a big help in any event.

Column 1 Column 2 Column 3 Column 4
aa text text text
bb
cc

dd text text text
ee

ww text text text
rr
tt

would end up as

Column 1 Column 2 Column 3 Column 4
aa bb cc text text text
dd ee text text text
ww rr tt text text text


There is only ever text on the first line of each set as I have shown it..and only ever three text items to the right of the data i'm trying tocombine between blanks.
Again thank you..
 
Last edited:
Upvote 0
wapo,

Before the macro:


Excel Workbook
AB
1aa
2bb
3
4ww
5xx
6zz
7
8rr
9
10gg
11hh
12ii
13jj
14
Sheet1



After the macro:


Excel Workbook
AB
1aaaa bb
2bb
3
4wwww xx zz
5xx
6zz
7
8rrrr
9
10gggg hh ii jj
11hh
12ii
13jj
14
Sheet1




Code:
Option Explicit
Sub CombineText()
Dim LR As Long, NR As Long, Hold As String, c As Range
Application.ScreenUpdating = False
NR = 1: Hold = ""
LR = Cells(Rows.Count, 1).End(xlUp).Row
For Each c In Range("A1:A" & LR + 1)
  If c <> "" Then
    Hold = Hold & c.Value & " "
  ElseIf c = "" Then
    If Right(Hold, 1) = " " Then
      Hold = Left(Hold, Len(Hold) - 1)
    End If
    Cells(NR, 2) = Hold
    Hold = ""
    NR = c.Row + 1
  End If
Next c
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Thank you Hiker95 brilliant solution... it achieves exactly what i need....big thankyou..

I was going to paste with excel genie but I'm at work and installing is barred by IT on my pc so was going to have to do it tonight at home, but this works perfectly...

Thanks..
 
Upvote 0
Hi wapo,

Though I realise you're happy with the excellent solution hiker95 has provided, I thought I'd tweak my attempt as well if nothing else but to see how two different people approach the same problem:

Code:
Sub Macro1()

Dim lngLastRow As Long
Dim lngPasteRow As Long
Dim strPasteCol As String
Dim strMyConcatenateString As String

    'Assumes the data and its last row can be found from Column A _
    - change if required.
    lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
    'Column to concatenate data _
    - change if required.
    strPasteCol = "B"
    
    Application.ScreenUpdating = False
    
    For Each cell In Range("A1:A" & lngLastRow + 1)
        If Len(cell) > 0 Then
            If lngPasteRow = 0 Then
                lngPasteRow = cell.Row
            End If
            If strMyConcatenateString = "" Then
                strMyConcatenateString = cell.Value
            Else
                strMyConcatenateString = strMyConcatenateString & " " & cell.Value
            End If
        Else
            Range(strPasteCol & lngPasteRow).Value = _
                strMyConcatenateString
            strMyConcatenateString = ""
            lngPasteRow = 0
        End If
    Next cell
    
    Application.ScreenUpdating = True
    
End Sub

HTH

Robert
 
Upvote 0

Forum statistics

Threads
1,213,506
Messages
6,114,027
Members
448,543
Latest member
MartinLarkin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top