Need some help constructing a Do While statement

[RogerM]

I would like to get information from column D of Sheet1 into column E of
Sheet2 where a one to many relationship exists between them (One row in
Sheet2 could have 0 to x matching rows in Sheet1). Column B in both sheets
contains the value (a text string) I want to compare. For each row in
Sheet2, the value of column B is always unique.

So for each row in Sheet2, I want to search Sheet1 to see if the values in
column B matches. If there is a match, then I want the value (a text
string) in column D of Sheet1 to be copied into Sheet2, column E. For any
additional matching rows in column B of Sheet1, then I want the value in
column D of Sheet1 to be appended to the value already contained in column E
of Sheet2. The data is Sheet1 is sorted on Column B, so whenever a match is
found in Sheet1, then the loop just needs to search the next row of Sheet1
until the values of column B don't match. At which point I need to go to
the next row in Sheet2 and start the comparison again.

I know this would require some type of Do While loops, but I'm not sure
where to begin as I haven't had much experience coding loops. Also, I'm not
sure how to append to the existing value in column E of Sheet2, since it
could change multiple times during the Do While. I assume that on each pass
of the Do While column B of Sheet1 matches column B of Sheet2, then I need
to update the value of the variable that stores the contents of column E in
Sheet2.

Anyway, what I want to do seems like it should be possible, and maybe it's
fairly easy to accomplish, but I need someone to point me in the right
direction. Thanks.

~Roger

 

[Don Guillett]

So I don't have to reconstruct, if desired, send your workbook to my address
below along with a snippet of this msg and before/after example.

 

[joel]

Sub combinesheets()

With Sheets("Sheet1")
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
Set Sht1ID = .Range("A1:A" & LastRow)
End With
With Sheets("Sheet1")
RowCount = 1
Do While .Range("A" & RowCount) <> ""
ID = .Range("A" & RowCount)
Set c = Sht1ID.Find(what:=ID, _
LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
FirstAddr = c.Address
Do
If Range("E" & RowCount) = "" Then
Range("E" & RowCount) = _
Range("E" & RowCount) & c.Offset(0, 3)
Else
Range("E" & RowCount) = _
Range("E" & RowCount) & ", " & _
c.Offset(0, 3)
End If

c = Sht1ID.FindNext(after:=c)
Loop While Not c Is Nothing And c.Address <> FirstAddr
End If
RowCount = RowCount + 1
Loop
End With

End Sub