Function that iterates cells in a column and concatenates the cells until it reads a specific string

[edsokolo]

The data I am working with contains blocks of cells in column C, with between 1-10 cells in them, that all have text in them. The blocks represent customer reviews. The last cell will always end with "(hide full review)".

I want to write a function that will move through the column and concatenate the cells together and then stop when it finds a cell that contains (hide full review) at end of it.

I found this function on mrexcel which almost works perfectly. The only problem it encounters is when reviews are only 1 line, it also concatenates the line after the blank cell.

Function colconc(CellRef As Range, Delimiter As String)

Dim LoopVar As Long
Dim StartRow As Long
Dim EndRow As Long
Dim Concat As String
Dim Col As Long

Col = CellRef.Column
StartRow = CellRef.row
EndRow = CellRef.End(xlDown).row

Concat = ""

For LoopVar = StartRow To EndRow
Concat = Concat & Cells(LoopVar, Col).Value
If LoopVar <> EndRow Then Concat = Concat & Delimiter
Next LoopVar

colconc = Concat
End Function

I tried modifying the function with the bold VBA below, but I am still struggling to get it to run correctly.

Function ColConcer(CellRef As Range, Delimiter As String)

Dim LoopVar As Long
Dim StartRow As Long
Dim EndRow As Long
Dim Concat As String
Dim Col As Long
Dim theendrow As Long
Dim txt As String
Dim c As Long

Col = CellRef.Column
Debug.Print Col
StartRow = CellRef.row
EndRow = CellRef.End(xlDown).row

For c = StartRow To EndRow
txt = Cells(c, 3).Value
If IsNumeric(InStr(1, txt, "(hide full review)")) = True Then
theendrow = Cells(LoopVar, Col)
End If
Next c

Concat = ""

For LoopVar = StartRow To theendrow
Concat = Concat & Cells(LoopVar, Col).Value
If LoopVar <> theendrow Then Concat = Concat & Delimiter
Next LoopVar

ColConcer = Concat
End Function

Any Help would be appreciated!

Best,
Eric

 

[skywriter]

Here's a start.
You should show an example of your data because I'm confused. Does your data always have a blank space after each review? Please be more specific.

Excel Workbook
	A	B
1	This is	This is a test. It is only a test. A short test. (hide full review)
2	a test.
3	It is only
4	a test.
5	A short test. (hide full review)
6
7	A short test. (hide full review)	A short test. (hide full review)
8
9	A short test. (hide full review)	A short test. (hide full review)
10
11	This is	This is a test. It is only a test. A short test. (hide full review)
12	a test.
13	It is only
14	a test.
15	A short test. (hide full review)
Sheet29

Function colconc(CellRef As Range, Delimiter As String)

Dim LoopVar As Long
Dim StartRow As Long
Dim EndRow As Long
Dim Concat As String
Dim Col As Long


Col = CellRef.Column
StartRow = CellRef.Row

If Cells(StartRow + 1, Col).Value = "" Then
colconc = Cells(StartRow, Col).Value
Exit Function
End If


EndRow = CellRef.End(xlDown).Row



For LoopVar = StartRow To EndRow
Concat = Concat & Cells(LoopVar, Col).Value
If LoopVar <> EndRow Then Concat = Concat & Delimiter
Next LoopVar

colconc = Concat
End Function

 

[edsokolo]

Sorry about not being clear. My data does always has a blank after each review, but only because I wrote a macro that inserts one after each review.

	A	B
1	username	username123
2	recommend:	Yes
3	title and date	Loved this product! 12/17/2013
4	review	here is part of the review
5		here is more text from the review
6		a little bit more
7		this is the end of the review. (hid full review)
8
9	username	othername123
10	recommend	no
11	title and date	This product sucks! 3/23/2014
12	review	This is a much shorter review. (hide full review)
13
14
15

<colgroup><col style="font-weight: bold; width: 30px;"><col style="width: 189px;"><col style="width: 382px;"></colgroup><tbody>
</tbody>

 

[edsokolo]

Thank you skywriter. That worked great.

If you wouldn't mind helping out again. i am now trying to make a a macro that clears the contents of the cells after it concatenates them, i.e. A1:A5 to B1, I want to clear the contents of A1:A5.

 

[skywriter]

Make sure the sheet you want to clear is the active sheet. If this isn't the exact range you want to clear just edit the range in the code.

Sub ClearContents()

Range("A1:A5, B1").ClearContents

End Sub