Concatenate cells in a column until blank cell

[McQuinge]

Hi!

I'm a newbie in vba, and got stucked with concatenating cells.
I'm using excel 2010 english version SP1.

Is there a way to concatenate cells until it meet a blank cell, and then start on the blank cell and concatenate cells until it meet a new blank cell? (using vba)

I have a report that is brought out of a system and saved as a workbook. My problem is that the report contains lot of text that is separated into cells in a column. At the moment the column contains 40.000 cells with text.

I will try to give you an example:
If you have a lyric that is splitted into verses, this is how my original report looks like. When I get this in a excel file, the verse is separated into cells, where each line get one cell.
And between the verses there is a blank cell.
The number of cells are not constant because the verses are not the same size or same amount of lines.

Original report:
Yesterday, all my troubles seemed so far away.
Now it looks as though they're here to stay.
Oh, I believe in yesterday.

Suddenly,
I'm not half the man I used to be,
There's a shadow hanging over me,
Oh, yesterday came suddenly.

Excel result:
A1: BLANK
A2: Yesterday, all my troubles seemed so far away.
A3: Now it looks as though they're here to stay.
A4: Oh, I believe in yesterday.
A5: BLANK
A6: Suddenly,
A7: I'm not half the man I used to be,
A8: There's a shadow hanging over me,
A9: Oh, yesterday came suddenly.
A10: BLANK

My Wish:
A1: Yesterday, all my troubles seemed so far away. Now it looks as though they're here to stay. Oh, I believe in yesterday.
A2: (NOT IMPORTANT, maybe delete row after A1 is complete)
A3: (NOT IMPORTANT, maybe delete row after A1 is complete)
A4: (NOT IMPORTANT, maybe delete row after A1 is complete)
A5: Suddenly, I'm not half the man I used to be, There's a shadow hanging over me, Oh, yesterday came suddenly.
A6: (NOT IMPORTANT, maybe delete row after A5 is complete)

Thanks for reading.
Hoping you can give me a clue!

 

[McQuinge]

Solved!

Thank you both, Jim May and MickG for your effort, I appreciated it!
I've learned much about the code I got from you.

Here's the code from Jim May that I have modified to get it exact as the example I started with!

And again, I see it's not easy to help me when I didn't tell you the whole case!

Please feel free to comment my changes, as I don't know any better way and wants to learn more!

Sub Foo()
Dim t As String
Dim M As Long
Dim M2 As Long
Dim Rng As Range, c As Range
Dim Lastrow As Long

M2 = 2
Lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

Set Rng = Range("A2:A" & lastrow)
        For Each c In Rng
            If c <> "" Then
            t = t & c & " "
            Else
                If c = "" Then
                M = c.Row
                    If t = "" Then
                    Else
                        t = Left(t, Len(t) - 1)
                        Cells(M2, 1).Value = t
                        t = ""
                        M2 = M
                    End If
                End If
            End If
        Next c
    t = Left(t, Len(t) - 1)
    Cells(M2, 1).Value = t
End Sub

 

[jim may]

Look fine!!
Jim

 

[DanBard]

This macro worked great. I was hoping that you could help me add the ability to concatenate the cells with a new line after each cell, as if I were using the alt enter or &CHAR(10)&.

I am terrible at editing code. I was also trying to change the code to a specific range of cells within the worksheet. Can you help make this change also.

Thank you

 

[Rjhopkins1]

Jim, I changed the "A" column to the "F" column for my purpose, to place the data in adjacent column cell. Where can I adjust, in your code, the row position? Sub Foo()
Dim w As Long
Dim t As String
Dim Rng As Range, c As Range
'w = 1
Set Rng = Selection
For Each c In Rng
If c <> "" Then
t = t & c & " "
Else
'w = w + 1
t = Left(t, Len(t) - 1)
c.Value = t
t = ""
End If
Next c
'w = w + 1
t = Left(t, Len(t) - 1)
Lr = Rng.Offset(Rng.Rows.Count).Row
Range("A" & Lr).Value = t
End Sub

 

[Excelsemi]

Hello

This code almost does what I need, however there need´s to change so that it places the data in the cell one spot to the right, so the blank cell is in column A, and then it has to place it in column C.
Also, my data has two blank cells, new data, two blank cells again, and then it have to copy the data from the cells in between the blank cells...
so:
A1: 1
A2: 2
A3: blank
A4: blank
A5: 3
A6: 4
A7: blank
A8: blank

that have to become
A1:blank
A2:blank C2: 1 2
A3: 1
A4: 2
A5: blank C5: 1 2
A6: blank C6: 3 4
A7: 3
A8: 4
A9: blank C9: 3 4
A10: blank C10: 6 7
A11: 6
A12: 7
A13: blank C13: 6 7
A14:blank

 

[gssidhu90]

Hi Jim,

I am new to this website and have working knowledge of excel.
I have an issue and hope you can help me out with that. It is almost the same as this thread. It is as follows:



Is there a way to concatenate cells until it meet a blank cell, and then start on the blank cell and concatenate cells until it meet a new blank cell? (using <acronym title="visual basic for applications" style="border-width: 0px 0px 1px; border-bottom-style: dotted; border-bottom-color: rgb(0, 0, 0); cursor: help; color: rgb(51, 51, 51); background-color: rgb(250, 250, 250);">vba</acronym>)

Example:
If I have a three to four cells that I want to concatenate into one, this is how my original report looks like. And between the verses there is a blank cell.
The number of cells are not constant because the verses are not the same size or same amount of lines.

Original report:
Yesterday, all my troubles seemed so far away.
Now it looks as though they're here to stay.
Oh, I believe in yesterday.

Suddenly,
I'm not half the man I used to be,
There's a shadow hanging over me,
Oh, yesterday came suddenly.

Excel result:
A1: Yesterday, all my troubles seemed so far away.
A2: Now it looks as though they're here to stay.
A3: Oh, I believe in yesterday.
A4: BLANK
A5: Suddenly,
A6: I'm not half the man I used to be,
A7: There's a shadow hanging over me,
A8: Oh, yesterday came suddenly.
A9: BLANK

My Wish:
A1: Yesterday, all my troubles seemed so far away. Now it looks as though they're here to stay. Oh, I believe in yesterday.
A2: Blank
A3: Blank
A4: Blank
A5: Suddenly, I'm not half the man I used to be, There's a shadow hanging over me, Oh, yesterday came suddenly.
A6: Blank
A7: Blank

Thanks in advance if you can give me a solution. Please

 

[Rick Rothstein]

Is there a way to concatenate cells until it meet a blank cell, and then start on the blank cell and concatenate cells until it meet a new blank cell? (using <acronym title="visual basic for applications" style="border-width: 0px 0px 1px; border-bottom-style: dotted; border-bottom-color: rgb(0, 0, 0); cursor: help; color: rgb(51, 51, 51); background-color: rgb(250, 250, 250);">vba</acronym>)

Example:
If I have a three to four cells that I want to concatenate into one, this is how my original report looks like. And between the verses there is a blank cell.
The number of cells are not constant because the verses are not the same size or same amount of lines.

Original report:
Yesterday, all my troubles seemed so far away.
Now it looks as though they're here to stay.
Oh, I believe in yesterday.

Suddenly,
I'm not half the man I used to be,
There's a shadow hanging over me,
Oh, yesterday came suddenly.

Excel result:
A1: Yesterday, all my troubles seemed so far away.
A2: Now it looks as though they're here to stay.
A3: Oh, I believe in yesterday.
A4: BLANK
A5: Suddenly,
A6: I'm not half the man I used to be,
A7: There's a shadow hanging over me,
A8: Oh, yesterday came suddenly.
A9: BLANK

My Wish:
A1: Yesterday, all my troubles seemed so far away. Now it looks as though they're here to stay. Oh, I believe in yesterday.
A2: Blank
A3: Blank
A4: Blank
A5: Suddenly, I'm not half the man I used to be, There's a shadow hanging over me, Oh, yesterday came suddenly.
A6: Blank
A7: Blank

In your original message you said the existing lines could be erased leaving just one blank row between each joined set of lyrics. The following code does that quite quickly, If you insist on maintaining the blanks for the existing rows of text, then the code will slow down dramatically. See if this works for you (make sure you run it against a copy of your data until you are sure it works as you want given that it replaces your existing data). Also, as a result of using Application.Transpose, there is an approximate 64,000 rows of data limit to this code.

Sub JoinLyrics()
  Dim Arr() As String
  Application.ScreenUpdating = False
  With Range("A2", Cells(Rows.count, "A").End(xlUp))
    Arr = Split(Replace(Join(Application.Transpose(.Value)), "  ", "    "), "  ")
    .Offset(-1, 1).Resize(UBound(Arr) + 1) = Application.Transpose(Arr)
  End With
  Columns("A").Delete
  Application.ScreenUpdating = True
End Sub

 

[gssidhu90]

In your original message you said the existing lines could be erased leaving just one blank row between each joined set of lyrics. The following code does that quite quickly, If you insist on maintaining the blanks for the existing rows of text, then the code will slow down dramatically. See if this works for you (make sure you run it against a copy of your data until you are sure it works as you want given that it replaces your existing data). Also, as a result of using Application.Transpose, there is an approximate 64,000 rows of data limit to this code.

Sub JoinLyrics()
  Dim Arr() As String
  Application.ScreenUpdating = False
  With Range("A2", Cells(Rows.count, "A").End(xlUp))
    Arr = Split(Replace(Join(Application.Transpose(.Value)), "  ", "    "), "  ")
    .Offset(-1, 1).Resize(UBound(Arr) + 1) = Application.Transpose(Arr)
  End With
  Columns("A").Delete
  Application.ScreenUpdating = True
End Sub

Hi Rick,

Thanks a lot for the reply. It worked quickly *** you said. But I need to maintain the blanks in place of older text. If you can help me out it will be great.

Thanks,
Gurpreet Singh

 

[Rick Rothstein]

I need to maintain the blanks in place of older text.

Give this macro a try then...

[table="width: 500"]
[tr]
	[td]Sub JoinLyricsRetainSpacing()
  Dim Ar As Range
  For Each Ar In Columns("A").SpecialCells(xlConstants).Areas
    Ar(1).Offset(, 1).Value = Trim(Join(Application.Transpose(Ar(1).Resize(Ar.Count + 1).Value)))
  Next
End Sub[/td]
[/tr]
[/table]

 

[gssidhu90]

Hi Rick,

It worked flawlessly. Thanks a lot for the help.

Regards,
Gurpreet Singh