combine multiple rows of data into one row.

L

LaDdIe

Happy New Year!

Could I have some help to find a solution to my task.

In column A
I have about 3000 rows of data,
The string in the first cell starts with the symbol >, which then follow
with strings in preceeding cells which do not start with the symbol >, then
again there may be a another string in a cell which does start with the
symbol >.

I need a macro that looks from top to bottom in col A for a string that
starts with >, then combine that string with other strings below that do not
start with >, if the string below starts with > then it should stop combining.

Simply put the symbol > denotes the start of a sentence.

Any help will save my little fingers goinig numb
 
J

Joel

This is the quick simple method. There are quicker more efficient methods if
this code run slow.

Sub combine()

RowCount = 1
Do While Range("A" & RowCount) <> ""
NextRow = Range("A" & (RowCount + 1))
If Left(NextRow, 1) <> ">" And _
NextRow <> "" Then
Range("A" & RowCount) = _
Range("A" & RowCount) & NextRow
Rows(RowCount + 1).Delete
Else
RowCount = RowCount + 1
End If
Loop
End Sub
 
C

Chip Pearson

The following code should work. You don't say where the combined
strings should be written to, so I write them one row at a time on
Sheet2. Change the value of the Dest variable to point to where the
combined strings should be written. Change the line

Set R = Range("A1") '<< or starting cell
to refer to the first string in the list.

The code assumes that the original data list resides on the worksheet
that is active in Excel.

Sub AAA()
Dim R As Range
Dim S As String
Dim LastRow As Long
Dim WS As Worksheet
Set WS = ActiveSheet
Dim Dest As Range

Set R = Range("A1") '<< or starting cell
With WS
LastRow = .Cells(.Rows.Count, R.Column).End(xlUp).Row
End With
Set Dest = Worksheets(2).Range("A1") '<<< CHANGE
Do Until R.Row > LastRow
If StrComp(Left$(R.Text, 1), ">", vbBinaryCompare) = 0 Then
If S <> vbNullString Then
Dest.Value = S
Set Dest = Dest(2, 1)
S = vbNullString
End If
End If
S = S & " " & R.Text
Set R = R(2, 1)
Loop
Dest.Value = S
End Sub

Cordially,
Chip Pearson
Microsoft Most Valuable Professional
Excel Product Group, 1998 - 2009
Pearson Software Consulting, LLC
www.cpearson.com
(email on web site)
 
L

LaDdIe

Job Done!!
Thank you so much, Best wishes 2009.

Joel said:
This is the quick simple method. There are quicker more efficient methods if
this code run slow.

Sub combine()

RowCount = 1
Do While Range("A" & RowCount) <> ""
NextRow = Range("A" & (RowCount + 1))
If Left(NextRow, 1) <> ">" And _
NextRow <> "" Then
Range("A" & RowCount) = _
Range("A" & RowCount) & NextRow
Rows(RowCount + 1).Delete
Else
RowCount = RowCount + 1
End If
Loop
End Sub
Click to expand...
 
L

LaDdIe

Hi, Also works a treat.
Thank you very much

Chip Pearson said:
The following code should work. You don't say where the combined
strings should be written to, so I write them one row at a time on
Sheet2. Change the value of the Dest variable to point to where the
combined strings should be written. Change the line

Set R = Range("A1") '<< or starting cell
to refer to the first string in the list.

The code assumes that the original data list resides on the worksheet
that is active in Excel.

Sub AAA()
Dim R As Range
Dim S As String
Dim LastRow As Long
Dim WS As Worksheet
Set WS = ActiveSheet
Dim Dest As Range

Set R = Range("A1") '<< or starting cell
With WS
LastRow = .Cells(.Rows.Count, R.Column).End(xlUp).Row
End With
Set Dest = Worksheets(2).Range("A1") '<<< CHANGE
Do Until R.Row > LastRow
If StrComp(Left$(R.Text, 1), ">", vbBinaryCompare) = 0 Then
If S <> vbNullString Then
Dest.Value = S
Set Dest = Dest(2, 1)
S = vbNullString
End If
End If
S = S & " " & R.Text
Set R = R(2, 1)
Loop
Dest.Value = S
End Sub

Cordially,
Chip Pearson
Microsoft Most Valuable Professional
Excel Product Group, 1998 - 2009
Pearson Software Consulting, LLC
www.cpearson.com
(email on web site)
Click to expand...
 
R

Rick Rothstein

While I know you have already have a solution to your problem, I thought you
(and others reading this thread) might be interested in a totally different
approach to doing what you asked. Just change the worksheet and range
references for the two Set statements to the source of your data and the
destination the "sentences" are to be placed at in this macro...

Sub CombineToSentences()
Dim X As Long, LastRow As Long
Dim AllWords As String, Words() As String, Sentences() As String
Dim Source As Range, Destination As Range
Set Source = Worksheets("Sheet1").Range("A2")
Set Destination = Worksheets("Sheet2").Range("B3")
With Source.Parent
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
ReDim Words(0 To LastRow - 1)
For X = 0 To LastRow - Source.Row
Words(X) = Source.Offset(X).Value
Next
End With
AllWords = Join(Words)
Sentences = Split(AllWords, ">")
For X = 1 To UBound(Sentences)
Destination.Offset(X - 1).Value = ">" & Sentences(X)
Next
End Sub

By the way, if your "sentences" are to be *real* sentences and they do not
need to preserve the greater than (>) symbol, just use this statement inside
the last For..Next loop in place of the statement I have there now...

Destination.Offset(X - 1).Value = Sentences(X)
 
L

Lars-Åke Aspelin

While I know you have already have a solution to your problem, I thought you
(and others reading this thread) might be interested in a totally different
approach to doing what you asked. Just change the worksheet and range
references for the two Set statements to the source of your data and the
destination the "sentences" are to be placed at in this macro...

Sub CombineToSentences()
Dim X As Long, LastRow As Long
Dim AllWords As String, Words() As String, Sentences() As String
Dim Source As Range, Destination As Range
Set Source = Worksheets("Sheet1").Range("A2")
Set Destination = Worksheets("Sheet2").Range("B3")
With Source.Parent
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
ReDim Words(0 To LastRow - 1)
For X = 0 To LastRow - Source.Row
Words(X) = Source.Offset(X).Value
Next
End With
AllWords = Join(Words)
Sentences = Split(AllWords, ">")
For X = 1 To UBound(Sentences)
Destination.Offset(X - 1).Value = ">" & Sentences(X)
Next
End Sub

By the way, if your "sentences" are to be *real* sentences and they do not
need to preserve the greater than (>) symbol, just use this statement inside
the last For..Next loop in place of the statement I have there now...

Destination.Offset(X - 1).Value = Sentences(X)
Click to expand...

The single "A" in the LastRow=... statement could be replaced with
Source.Column
Otherwise that statement will also have to be modified if you have
another source location than in column A.

/ Lars-Åke
 
R

Rick Rothstein

The single "A" in the LastRow=... statement could be replaced with
Source.Column
Otherwise that statement will also have to be modified if you have
another source location than in column A.
Click to expand...

It was supposed to have been... I missed it when I converted my hard-coded
references (used to test out the concept behind the macro's code) to the
relative references I eventually changed them to. Thanks for catching that
oversight for me. For those following this thread, here is the corrected
code (so you can copy/paste it if desired)...

Sub CombineToSentences()
Dim X As Long, LastRow As Long
Dim AllWords As String, Words() As String, Sentences() As String
Dim Source As Range, Destination As Range
Set Source = Worksheets("Sheet1").Range("A2")
Set Destination = Worksheets("Sheet2").Range("B3")
With Source.Parent
LastRow = .Cells(.Rows.Count, Source.Column).End(xlUp).Row
ReDim Words(0 To LastRow - 1)
For X = 0 To LastRow - Source.Row
Words(X) = Source.Offset(X).Value
Next
End With
AllWords = Join(Words)
Sentences = Split(AllWords, ">")
For X = 1 To UBound(Sentences)
Destination.Offset(X - 1).Value = ">" & Sentences(X)
Next
End Sub

My same comment from my first posting about removing the ">" &
(greater than symbol.. space... ampersand) from the statement in the last
For..Next loop still applies.
[/QUOTE]
 
Top