Combining cells if adjacent cells empty until non-empty cell reached

[bookworm121]

Hi all!

I have 2 columns, C and D.

Basically, column D contains fragments of a sentence. I need to combine these fragments into one cell. The indication of where the beggining and end of the sentence is in column C. When the adjacent cell in column C is NOT empty, this means the sentence starts here. The sentence will continue until the previous adjacent cell from column C is once again NOT empty (non-inclusive). The sentence is built backwards.

For example: (where "nothing" is written indicates a blank cell, where a number is written indicates a non empty cell)

C D
0 random.
nothing The.
nothing sky
nothing is
nothing very
1 Blue
nothing He

In this example, the sentence is "The sky is very blue.". A illustrated, when column C is not blank, the sentence starts, and works backwards until the next non-empty C cell (non-inclusive).

The words "He" and "random." are the beggining and end of 2 different sentences.

I need a macro that would be able to do this on a spreadsheet of any size. This means columns C and D may be 100 rows, 2000 rows, 2 rows or any random number of rows.

I was thinking I need to use "&" somehow, but i really can't seem to wrap my head around how to do this.

Any help would be appreciated! thanks!

 

[cgcamal]

Hi bookworm121,

Try this:

Sub Combine_Cells()
'Done by César C., 22/06/2011

Dim SentencesRow(), LastRow As Integer, NotEmptyRows As Integer
Dim i As Integer, j As Integer

Application.ScreenUpdating = False
Application.DisplayAlerts = False

LastRow = Range("C" & Rows.Count).End(xlUp).Row
NotEmptyRows = WorksheetFunction.CountA(Range("C1:C" & LastRow))

If NotEmptyRows > 0 Then
    ReDim SentencesRow(1 To NotEmptyRows)
    'Loading array of row position
    j = 1
    For i = 1 To LastRow
        If Not IsEmpty(Cells(i, "C")) Then
            SentencesRow(j) = i
            j = j + 1
        End If
    Next
    'Modifying values in column D before to combine
    For i = 1 To UBound(SentencesRow) - 1
        For j = (SentencesRow(i) + 1) To SentencesRow(i + 1) - 1
            Cells(SentencesRow(i) + 1, "D") = Cells(SentencesRow(i) + 1, "D") & " " & Cells(j + 1, "D")
        Next
    Next
    'Combining cells by sentence
    For i = 1 To UBound(SentencesRow) - 1
        With Range("D" & SentencesRow(i) + 1 & ":D" & SentencesRow(i + 1))
            .Merge
            .HorizontalAlignment = xlGeneral
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlTop
            .WrapText = True
        End With
    Next
End If
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Hope this helps.

Regards