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

I

iKnowYou

New Member
Joined
Mar 2, 2016
Messages
4
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),""))))))
 
Sort by date Sort by votes
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?


ABCDEF
INOUT
aa.bb ccc.ddd.ee ff gggg. aa. bb ccc. ddd. ee ff gggg. hhhh. ii j. kkk.
hhhh.ii j.kkk.
aa. bb ccc. ddd. ee ff gggg. hhhh. ii j. kkk. lll mmm. nn ooo pp. qqq.
aa.bb ccc.ddd.ee ff gggg.
hhhh.ii j.kkk.lll mmm. qw. as. as asasas.
nn ooo pp.qqq.
qw.as.as asasas.

<tbody>
[TD="align: center"]1[/TD]

[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]2[/TD]

[TD="align: right"][/TD]

[TD="align: center"]3[/TD]

[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]4[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]5[/TD]

[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]6[/TD]

[TD="align: right"][/TD]

[TD="align: center"]7[/TD]

[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]8[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]9[/TD]

[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

</tbody>

Code: 
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
 
Upvote 0
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.

AF
INOUT
aa. bb. aa. bb ccc. ddd. ee ff.
cc. dd.
ee. ff.
ab. ab. abab. ab. ab. cd.cd
cd. cd.
cc. cc. jjcc. cc. jj

<tbody>
[TD="align: center"]1[/TD]

[TD="align: right"][/TD]

[TD="align: center"][/TD]

[TD="align: right"][/TD]

[TD="align: center"]2[/TD]

[TD="align: right"][/TD]

[TD="align: center"]3[/TD]

[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]4[/TD]

[TD="align: right"][/TD]

[TD="align: center"]5[/TD]

[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]6[/TD]

[TD="align: right"][/TD]

[TD="align: center"]7[/TD]

[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]8[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]9[/TD]

[TD="align: right"][/TD]

[TD="align: center"]10[/TD]

[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]11[/TD]

[TD="align: right"][/TD]
[TD="align: right"][/TD]

</tbody>
Click to expand...
 
Upvote 0
Code: 
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
 
Upvote 0
You're the best, just ran it across 150000 rows and it did it perfectly.

StephenCrump said:
Code: 
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
Click to expand...
 
Upvote 0
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:

Code: 
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
 
Upvote 0
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!

StephenCrump said:
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:

Code: 
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
Click to expand...
 
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Solved
Dynamic Sum Range Addresses...(?)
Replies
2
Views
594
Kenny_D
K
G
  • Question Question
Improve calculation speed for this worksheet with INDIRECT/FILTER functions
Replies
0
Views
644
GeneBF
G
J
  • Question Question
out of my league, need help
Replies
1
Views
131
Simadri1986
Simadri1986
U
  • Solved
Rewrite Code as a Sub to work on Active Sheet
Replies
2
Views
227
Skyybot
Skyybot
P
  • Solved
Proper syntax for horizonal alignment within a column
Replies
2
Views
126
pelkbc5172
P

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top