VBA - Concatenate based on values in another cell

[hoodedrobin1]

I have some advance concatenate questions I am having a problem solving.

I have some data that is incorrectly broken into separate rows when scraping data from a website. I want to be able to combine the rows in question into the same row as text found on the left of said column.

Hopefully below someone can see how I need to do. The fifth column (E) is not in one cell and needs to be grouped based on text to the left.

concatenate column e into row with text for exable E1&E2 concatenate into E2

<tbody>
</tbody><colgroup><col></colgroup>

also

concatenate column e into row with text for exable E20&E21&E22 concatenate into E21

<tbody>
</tbody><colgroup><col></colgroup>

				Saved
Parker, Peter	PP	Hero	12008	Dog	1	5/4/2017	Yes
				Saved
Kent, Clark	CK	Hero	12008	Dog	1	5/15/2017	Yes
				Saved
Gardner, Guy	GG	Hero	12008	Dog	1	5/4/2017	Yes
				Saved
Stark, Tony	TS	Hero	12208	Cat	2	5/5/2017	Yes
				Saved
Rodgers, Steve	SR	Hero	12208	Cat	2	5/15/2017	Yes
				Saved
Wayne, Bruce	BW	Hero	12208	Cat	2	5/4/2017
				Saved
Allen, Barry	BA	Hero	12408	Girl	1	5/6/2017	Yes
				Saved
Xavier, Charles	CX	Hero	12408	Girl	1	5/16/2017	Yes
				Saved
Grey, Jean	JG	Hero	12408	Family	1	5/4/2017	Yes
				Of 5
				Saved
Banner, Bruce	BB	Hero	12708	Bus	1	5/8/2017	Yes
				Defeated Villian
				Saved
Summers, Scott	SS	Hero	12408	Family	1	5/4/2017	Yes
				Of 5

<tbody>
</tbody><colgroup><col><col><col><col><col><col><col><col></colgroup>

 

[wideboydixon]

I can't be 100% certain that this is right because I'm not clear on whether the blank lines belong to the cell above or below them but this does what you said in your description for the data posted:

Public Sub ConcatenateColumnE()

Dim lastRow As Long
Dim thisRow As Long
Dim currentValue As String

' Find the last row with an entry in column E
lastRow = Cells(Rows.Count, 5).End(xlUp).Row

' Start on the first row
thisRow = 1

' Keep going until the end
Do While thisRow <= lastRow
    ' Does this row have an empty cell in column A?
    If Trim$(Cells(thisRow, 1).Value) = "" Then
        ' Remember the value from column E and remove the row
        currentValue = currentValue & Cells(thisRow, 5).Value & vbCrLf
        Rows(thisRow).Delete xlShiftUp
        
        ' Since we've removed a row, the last row has moved up one
        lastRow = lastRow - 1
    Else
        ' Enter the remembered values from column E
        Cells(thisRow, 5).Value = currentValue & Cells(thisRow, 5).Value
        currentValue = ""
        
        ' Process the next row
        thisRow = thisRow + 1
    End If
Loop

End Sub

WBD

 

[hoodedrobin1]

I can't be 100% certain that this is right because I'm not clear on whether the blank lines belong to the cell above or below them but this does what you said in your description for the data posted:
WBD

Wideboydixon, I color coded them. Some lines have 2 rows of data in column E some have 3 or 4.

At the bottom you can see that there are 2 blanks above Banner, Bruce but only "Saved, Bus, Defeated Villain" is related, not "Of 5"

-HoodedRobin1

 

[hoodedrobin1]

By the way I believe your formula works.

I don't know how to edit a previous post.

-HoodedRobin1

 

[wideboydixon]

ADVERTISEMENT

Ahh. Now the colours make sense! What's the logic for deciding which row the extra cells belong to? I assume your sheet is not colour-coded.

WBD

 

[wideboydixon]

By the way I believe your formula works.

I don't know how to edit a previous post.

-HoodedRobin1

I don't think it works based on your colour coding.

WBD

 

[hoodedrobin1]

I actually set my test sheet up incorrectly... (I had to change every field because it was proprietary)

When I ran your code, it was legible and made sense (on my real data)



So thank you again!

 

[wideboydixon]

OK. Cool! You're welcome

WBD