Need macro that concatenates cells with text

[andrei]

I have in column A cells with the following content :

A1 : Mother
A2 : go
A3 : home
A4 : ( empty cell)
A5: ( empty cell)
A6 : Daddy
A7 : works
A8 : in a
A9 : mine
A10 : (empty cell)
A11 : My uncle
A12 : is a spy

What i want in a macro which does that

B1 : Mother go home
B2 : Daddy works in a mine
B3 : My uncle is a spy

The macro should concatenate the cells with text and "understand" empty
cells as delimiter .

 

[Gary''s Student]

Give this a try:

Sub sentences()
Dim n As Long, k As Long
Dim s As String, v As String
n = Cells(Rows.Count, 1).End(xlUp).Row + 1
k = 1
s = ""
For i = 1 To n
v = Cells(i, 1).Value
If v <> "" Then
If s = "" Then
s = v
Else
s = s & " " & v
End If
Else
If Cells(i - 1, 1).Value = "" Then
Else
Cells(k, 2).Value = s
s = ""
k = k + 1
End If
End If
Next
End Sub

 

[Rick Rothstein]

Assuming your cells contain text (as your post indicated they did) and not
formulas, give this code a try (set the DataStartCell and the
DestinationStartCell for your actual setup)....

Sub Concatter()
Dim X As Long, Off As Long, R As Range, LastCell As Range
Dim DataStartCell As Range, DestinationStartCell As Range
Set DataStartCell = Range("A1")
Set DestinationStartCell = Range("B1")
Set LastCell = Cells(Rows.Count, DataStartCell.Column).End(xlUp)
Set R = Range(DataStartCell, LastCell).SpecialCells(xlCellTypeConstants)
For X = 1 To R.Areas.Count
DestinationStartCell.Offset(Off).Value = _
Join(WorksheetFunction.Transpose(R.Areas(X)))
Off = Off + 1
Next
End Sub

 

[Mike H]

Hi,

Right click your sheet tab, view code and paste the code below in and run it,

Sub sonic()
Dim OutRow As Long, Lastrow As Long
Dim TempString As String
OutRow = 1
Lastrow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
Set MyRange = Range("A1:A" & Lastrow)
For Each c In MyRange
If c.Value = "" Then GoTo getmeout
TempString = TempString & c.Value & " "
If c.Offset(1).Value = "" Then
Cells(OutRow, 2).Value = Trim(TempString)
TempString = ""
OutRow = OutRow + 1
End If
getmeout:
Next
End Sub


Mike

 

[Rick Rothstein]

For instruction purposes, if we eliminate the generalization code and simply use the source and destination cells you indicated, we can make my code look a lot less scary<g>....

Sub Concatter()
Dim X As Long, Off As Long, R As Range
Set R = Range(Range("A1"), Cells(Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeConstants)
For X = 1 To R.Areas.Count
Range("B1").Offset(Off).Value = Join(WorksheetFunction.Transpose(R.Areas(X)))
Off = Off + 1
Next
End Sub

Again, this assumes the cells contain text constants.

 

[Gary''s Student]

Very Nice!
--
Gary''s Student - gsnu200905

Assuming your cells contain text (as your post indicated they did) and not
formulas, give this code a try (set the DataStartCell and the
DestinationStartCell for your actual setup)....

Sub Concatter()
Dim X As Long, Off As Long, R As Range, LastCell As Range
Dim DataStartCell As Range, DestinationStartCell As Range
Set DataStartCell = Range("A1")
Set DestinationStartCell = Range("B1")
Set LastCell = Cells(Rows.Count, DataStartCell.Column).End(xlUp)
Set R = Range(DataStartCell, LastCell).SpecialCells(xlCellTypeConstants)
For X = 1 To R.Areas.Count
DestinationStartCell.Offset(Off).Value = _
Join(WorksheetFunction.Transpose(R.Areas(X)))
Off = Off + 1
Next
End Sub

 

[Rick Rothstein]

Thanks, but I'm sure it looks kind of "scary" to the majority of readers in its generalized form; hence my second, less scary looking (hopefully<g>) posting of the same code with all the generalizations removed.

 

[andrei]

Thank you guys !