Macro to concatenate data between blank cells in a column in excel

[setanta]

Hi,

I was wondering if someone could help me with the following query please?
I would like to concatenate each set of data between the blank cells and return the value in the next column in line with the final row of data before the blank.

I have found a piece of code and modified it slightly but it is not doing exactly what I want, instead it returns just one concatenate of all the data in a predetermined row.

Thanks in advance,
Setanta

VB Code

Option Explicit
Sub ConcatRangeNoBlanks()
Dim c As Range, rng As Range
Application.ScreenUpdating = False
Set rng = Range("A1:A100")
For Each c In rng
  If c > 0 Then
    Cells(6, 2) = Cells(6, 2) & " " & c
  End If
Next c
Columns(1).AutoFit
Application.ScreenUpdating = True
End Sub

Current result

A	B
1
2
3	123456
4
5
6

Desired Result

A	B
1
2
3	123
4
5
6	456

[NoS]

alter your code to include something like this:

Dim concat as String

For Each c In rng
    If c > 0 Then
        concat = concat & " " &  c.Value
    Else
        c.Offset(-1, 1).Value = concat
        concat = ""
    End If
Next c

[setanta]

alter your code to include something like this:

NoS,

Thanks a lot for this, you have been a big help,

One last question, if I wanted to return the full concatenated range at the first non blank cell of the entire concatenation, how would I modify the code to do this? Some datasets will have 5 rows, other 10, others 20 between blanks e.g.

1 123
2
3

4 456
5
6

7
8
9
10
11 7891011


WIP Code

Option Explicit
Sub ConcatRangeNoBlanks()
Dim c As Range, rng As Range
Dim concat As String
Application.ScreenUpdating = False
Set rng = Range("A1:A30")
For Each c In rng
If c > 0 Then
concat = concat & " " & c.Value
Else
c.Offset(-1, 1).Value = concat
concat = ""
End If
Next c
Columns(1).AutoFit
Application.ScreenUpdating = True
End Sub

[NoS]

setanta, your example differs between the top two and last set of numbers as to where the result is placed. Assuming you are after the top example, this should work.

Sub ConcatRangeNoBlanks()

    Dim c As Range
    Dim rng As Range
    Dim concat As String
    Dim i As Integer

Application.ScreenUpdating = False

Set rng = Range("A1:A30")
concat = ""
i = 0

For Each c In rng
    If c > 0 Then
        concat = concat & " " & c.Value
        i = i + 1
    Else
        c.Offset(-i, 1).Value = concat
        concat = ""
        i = 0
    End If
Next c

Columns(2).AutoFit

Application.ScreenUpdating = True

End Sub

Hope this helps
NoS

[carl0308]

Dear Setanta,

I just fool around your code and get the answer you want accidentally. Actually, I want the same result (i.e. to return the full concatenated range at the first non blank cell of the entire concatenation) as yours. Here's the code for your reference. Though it's been years since your posting of question, please take a look if you still interest in it.

Sub ConcatRangeNoBlanks_seems_OK()

    Dim c As Range
    Dim rng As Range
    Dim concat As String
    Dim i As Integer

Application.ScreenUpdating = False


Set rng = Range("A1:A30")
concat = ""
i = 0


For Each c In rng
    If c > 0 Then
        concat = concat & " " & c.Value
        i = i
    Else
        c.Offset(-i, 0).Value = concat
        concat = ""
        i = 0
    End If
Next c

Columns(2).AutoFit

Application.ScreenUpdating = True
End Sub

Cheers!
Carl