Please help me translate this long/ridiculous formula to an efficient and effective VBA code

[iKnowYou]

I have a 100 rows of notes all listed across rows in one column. Each paragraph includes one or multiple rows, then there is a gap/empty row, then the next paragraph starts. I want the VBA to concatenate these rows accordingly to construct a paragraph, then moved to the next set of rows to continue doing the same. if its a one line/row, then it would only return that one line. The code below works for a paragraph up to 6 or 7 lines, not defective at all. some paragraphs include 10 to 15 rows. Please let me know if its not clear.

My logic starts with:
IF the cell to left IS NOT BLANK, and the cell above it (top left) IS BLANK (indicator of the beg)inning of a paragraph), IF the cell below it IS NOT BLANK, below left (indicates that there are at least two cells to be concatenated), CONCATENATE them if the following cell IS BLANK, otherwise keep checking until reach a blank cell then CONCATENATE all of the row/cells up to that line.



IF(AND(INDIRECT("RC[-1]",0)<>"",INDIRECT("R[-1]C[-1]",0)="",INDIRECT("R[1]C[-1]",0)=""),INDIRECT("RC[-1]",0),IF(AND(INDIRECT("RC[-1]",0)<>"",INDIRECT("R[-1]C[-1]",0)="",INDIRECT("R[1]C[-1]",0)<>"",INDIRECT("R[2]C[-1]",0)=""),CONCATENATE(C124," ",C125),IF(AND(INDIRECT("RC[-1]",0)<>"",INDIRECT("R[-1]C[-1]",0)="",INDIRECT("R[1]C[-1]",0)<>"",INDIRECT("R[2]C[-1]",0)<>"",INDIRECT("R[3]C[-1]",0)=""),CONCATENATE(C124," ",C125," ",C126),IF(AND(INDIRECT("RC[-1]",0)<>"",INDIRECT("R[-1]C[-1]",0)="",INDIRECT("R[1]C[-1]",0)<>"",INDIRECT("R[2]C[-1]",0)<>"",INDIRECT("R[3]C[-1]",0)<>"",INDIRECT("R[4]C[-1]",0)=""),CONCATENATE(C124," ",C125," ",C126," ",C127),IF(AND(INDIRECT("RC[-1]",0)<>"",INDIRECT("R[-1]C[-1]",0)="",INDIRECT("R[1]C[-1]",0)<>"",INDIRECT("R[2]C[-1]",0)<>"",INDIRECT("R[3]C[-1]",0)<>"",INDIRECT("R[4]C[-1]",0)<>"",INDIRECT("R[5]C[-1]",0)=""),CONCATENATE(C124," ",C125," ",C126," ",C127," ",C128),IF(AND(INDIRECT("RC[-1]",0)<>"",INDIRECT("R[-1]C[-1]",0)="",INDIRECT("R[1]C[-1]",0)<>"",INDIRECT("R[2]C[-1]",0)<>"",INDIRECT("R[3]C[-1]",0)<>"",INDIRECT("R[4]C[-1]",0)<>"",INDIRECT("R[5]C[-1]",0)<>"",INDIRECT("R[6]C[-1]",0)=""),CONCATENATE(C124," ",C125," ",C126," ",C127," ",C128," ",C129),""))))))

 

[StephenCrump]

Welcome to the Forum!

A bit of a guess, because I haven't tried to decipher your formula, and I don't know your layout ...

Are we on the right track?

	A	B	C	D	E	F
1	IN					OUT
2	aa.	bb ccc.	ddd.	ee ff gggg.		aa. bb ccc. ddd. ee ff gggg. hhhh. ii j. kkk.
3	hhhh.	ii j.	kkk.
4						aa. bb ccc. ddd. ee ff gggg. hhhh. ii j. kkk. lll mmm. nn ooo pp. qqq.
5	aa.	bb ccc.	ddd.	ee ff gggg.
6	hhhh.	ii j.	kkk.	lll mmm.		qw. as. as asasas.
7	nn ooo pp.	qqq.
8
9	qw.	as.	as asasas.

<tbody>
</tbody>

Sub MakeParagraphs()

    Dim rngIn As Range
    Dim sOut() As String
    Dim lCount As Long, r As Long, c As Long
    
    Set rngIn = Range("A2:D9")    'say
    ReDim sOut(1 To rngIn.Rows.Count)
    lCount = 1
    
    For r = 1 To rngIn.Rows.Count
        For c = 1 To rngIn.Columns.Count
            If rngIn(r, c).Value = "" Then
                lCount = lCount + 1
                Exit For
            Else
                sOut(lCount) = sOut(lCount) & " " & rngIn(r, c).Value
            End If
        Next c
    Next r
    
    Range("F2").Resize(lCount).Value = Application.Transpose(sOut)


End Sub

 

[iKnowYou]

Thanks for the response. Everything is laid out across one column like below. Basically below table shows 3 separate sentences. Its logic can be broken out in 4 different pieces technically. 1) a cell with a blank cell above it is the beginning of a sentence. 2) A cell with a blank cell above and Not a blank below it is the beginning of a sentence with at least 2 lines 3) if a cell is not blank and both above and below are blank, then its a one liner. 4) Code identifies the beginning of a sentence, then continues searching vertically for a blank cell (the gap between the two sentence), then concatenates all the cells it searched through in one cell. Nothing is returned in any of the adjacent cells besides the very first cell where are the cell are concatenated in.

	A		F
1	IN		OUT
2	aa. bb.		aa. bb ccc. ddd. ee ff.
3	cc. dd.
4	ee. ff.
5
6	ab. ab. ab		ab. ab. ab. cd.cd
7	cd. cd.
8
9	cc. cc. jj		cc. cc. jj
10
11

<tbody>
</tbody>

 

[StephenCrump]

Sub MakeParagraphs()

    Dim rngIn As Range
    Dim sOut() As String
    Dim lCount As Long, r As Long
    
    Set rngIn = Range("A2:A9")
    ReDim sOut(1 To rngIn.Rows.Count)
    lCount = 1
    
    For r = 1 To UBound(sOut)
        If rngIn(r).Value = "" Then
            lCount = r + 1
        Else
            sOut(lCount) = sOut(lCount) & " " & rngIn(r).Value
        End If
    Next r
    
    rngIn.Offset(, 5).Value = Application.Transpose(sOut)

End Sub

 

[iKnowYou]

You're the best, just ran it across 150000 rows and it did it perfectly.

Sub MakeParagraphs()

    Dim rngIn As Range
    Dim sOut() As String
    Dim lCount As Long, r As Long
    
    Set rngIn = Range("A2:A9")
    ReDim sOut(1 To rngIn.Rows.Count)
    lCount = 1
    
    For r = 1 To UBound(sOut)
        If rngIn(r).Value = "" Then
            lCount = r + 1
        Else
            sOut(lCount) = sOut(lCount) & " " & rngIn(r).Value
        End If
    Next r
    
    rngIn.Offset(, 5).Value = Application.Transpose(sOut)

End Sub

 

[StephenCrump]

Great! I'm glad it worked for you ...

... but you must have broken your 150,000 rows into chunks, because Transpose can't accommodate > 65,536 rows (the old Excel limit).

Here's some tweaked code that will take you beyond that limit:

Sub MakeParagraphs()

    Dim rngIn As Range
    Dim sOut() As String
    Dim lCount As Long, r As Long
    
    Set rngIn = Range("A2:A1000000")
    ReDim sOut(1 To rngIn.Rows.Count, 1 To 1)
    lCount = 1
    
    For r = 1 To UBound(sOut)
        If rngIn(r).Value = "" Then
            lCount = r + 1
        Else
            sOut(lCount, 1) = sOut(lCount, 1) & " " & rngIn(r).Value
        End If
    Next r
    
    rngIn.Offset(, 5).Value = sOut

End Sub

 

[iKnowYou]

Great!! Yes, it did cause a problem even after I extend the range. i'm trying to understand the code you wrote, it worked perfectly. thanks again for your help!

Great! I'm glad it worked for you ...

... but you must have broken your 150,000 rows into chunks, because Transpose can't accommodate > 65,536 rows (the old Excel limit).

Here's some tweaked code that will take you beyond that limit:

Sub MakeParagraphs()

    Dim rngIn As Range
    Dim sOut() As String
    Dim lCount As Long, r As Long
    
    Set rngIn = Range("A2:A1000000")
    ReDim sOut(1 To rngIn.Rows.Count, 1 To 1)
    lCount = 1
    
    For r = 1 To UBound(sOut)
        If rngIn(r).Value = "" Then
            lCount = r + 1
        Else
            sOut(lCount, 1) = sOut(lCount, 1) & " " & rngIn(r).Value
        End If
    Next r
    
    rngIn.Offset(, 5).Value = sOut

End Sub