For Each Value in Sheat1 A:A, Search Sheat2 A:A, Copy An:An+? and Paste Sheat1 B:B

[Homeskool]

Hi All,

I'm new here, but I've used excel and macros occasionally in the last few years. Usually I've been able to figure things out from the posts and replies of others, but this time I'm stuck. So here it goes...

I have 1xWB with 2xWS. WS1 has 3xColumns, WS2 has 1xColumn:

WS1​

[TABLE="class: grid, width: 250"]
<tbody>[TR]
[TD]ID
[/TD]
[TD]Other Data
[/TD]
[TD]Summary
[/TD]
[/TR]
[TR]
[TD]S990
[/TD]
[TD]--stuff--
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]S991
[/TD]
[TD]--stuff--
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]I599
[/TD]
[TD]--stuff--
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]S992
[/TD]
[TD]--stuff--
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]S993
[/TD]
[TD]--stuff--
[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

WS2​

[TABLE="class: grid, width: 250"]
<tbody>[TR]
[TD]garbage text I don't care about
[/TD]
[/TR]
[TR]
[TD]S992 and some text
[/TD]
[/TR]
[TR]
[TD]some more text 1
[/TD]
[/TR]
[TR]
[TD]Quality: even more text 1
[/TD]
[/TR]
[TR]
[TD]<blank cell=""><blank cell="">--blank cell--</blank></blank>
[/TD]
[/TR]
[TR]
[TD]text I599 and some text
[/TD]
[/TR]
[TR]
[TD]--blank cell--
[/TD]
[/TR]
[TR]
[TD]even more text 2
[/TD]
[/TR]
[TR]
[TD]Quality: just a bit more text 2
[/TD]
[/TR]
[TR]
[TD]<blank cell=""><blank cell="">--blank cell--</blank></blank>
[/TD]
[/TR]
</tbody>[/TABLE]
I'm looking for VBA that will search WS2 for the text in each row of Column A in WS1, and then copy and paste the text in each cell below that until the next cell with "Quality:" as part of the text, into a single cell of the appropriate row of the Description column in WS1. So I get the following in WS1:

WS1​

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]ID
[/TD]
[TD]Other Data
[/TD]
[TD]Summary
[/TD]
[/TR]
[TR]
[TD]S990
[/TD]
[TD]--stuff--
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]S991
[/TD]
[TD]--stuff--
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]I599
[/TD]
[TD]--stuff--
[/TD]
[TD]text I599 and some text even more text 2 Quality: just a bit more text 2
[/TD]
[/TR]
[TR]
[TD]S992
[/TD]
[TD]--stuff--
[/TD]
[TD]S992 and some text some more text 1 Quality: even more text 1
[/TD]
[/TR]
[TR]
[TD]S993
[/TD]
[TD]--stuff--
[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

WS1 has about 200 ID values that need to be searched for. WS2 has 5k rows of text that need to be moved to the corresponding ID.

I'd greatly appreciate any help I can get, but please be patient with my non-VBA savvy mind. I can provide additional clarification if required. Thanks and good luck!

-Homeskool

 

[AlphaFrog]

[color=darkblue]Sub[/color] Copy_Stuff()
    [color=darkblue]Dim[/color] ws1 [color=darkblue]As[/color] Worksheet, ws2 [color=darkblue]As[/color] Worksheet
    [color=darkblue]Dim[/color] Found [color=darkblue]As[/color] Range, cell [color=darkblue]As[/color] Range, strStuff [color=darkblue]As[/color] [color=darkblue]String[/color]
    
    [color=darkblue]Set[/color] ws1 = Sheets(1)
    [color=darkblue]Set[/color] ws2 = Sheets(2)
    
    Application.ScreenUpdating = [color=darkblue]False[/color]
    
    [color=darkblue]For[/color] [color=darkblue]Each[/color] cell [color=darkblue]In[/color] ws1.Range("A2", ws1.Range("A" & Rows.Count).End(xlUp))
        [color=darkblue]Set[/color] Found = ws2.Range("A:A").Find(cell.Value, , xlValues, xlPart, 1, 1, 0)
        [color=darkblue]If[/color] [color=darkblue]Not[/color] Found [color=darkblue]Is[/color] [color=darkblue]Nothing[/color] [color=darkblue]Then[/color]
            strStuff = Found.Value
            i = 0
            [color=darkblue]Do[/color]
                DoEvents
                i = i + 1
                [color=darkblue]If[/color] Found.Offset(i).Value <> "" [color=darkblue]Then[/color] strStuff = strStuff & " " & Found.Offset(i).Value
            [color=darkblue]Loop[/color] [color=darkblue]Until[/color] i = 100 [color=darkblue]Or[/color] Found.Offset(i) [color=darkblue]Like[/color] "Quality*"
            cell.Offset(, 2).Value = strStuff
        [color=darkblue]End[/color] [color=darkblue]If[/color]
    [color=darkblue]Next[/color] cell
    
    Application.ScreenUpdating = [color=darkblue]True[/color]
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]

 

[Homeskool]

[COLOR=darkblue]Sub[/COLOR] Copy_Stuff()
    [COLOR=darkblue]Dim[/COLOR] ws1 [COLOR=darkblue]As[/COLOR] Worksheet, ws2 [COLOR=darkblue]As[/COLOR] Worksheet
    [COLOR=darkblue]Dim[/COLOR] Found [COLOR=darkblue]As[/COLOR] Range, cell [COLOR=darkblue]As[/COLOR] Range, strStuff [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
    
    [COLOR=darkblue]Set[/COLOR] ws1 = Sheets(1)
    [COLOR=darkblue]Set[/COLOR] ws2 = Sheets(2)
    
    Application.ScreenUpdating = [COLOR=darkblue]False[/COLOR]
    
    [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Each[/COLOR] cell [COLOR=darkblue]In[/COLOR] ws1.Range("A2", ws1.Range("A" & Rows.Count).End(xlUp))
        [COLOR=darkblue]Set[/COLOR] Found = ws2.Range("A:A").Find(cell.Value, , xlValues, xlPart, 1, 1, 0)
        [COLOR=darkblue]If[/COLOR] [COLOR=darkblue]Not[/COLOR] Found [COLOR=darkblue]Is[/COLOR] [COLOR=darkblue]Nothing[/COLOR] [COLOR=darkblue]Then[/COLOR]
            strStuff = Found.Value
            i = 0
            [COLOR=darkblue]Do[/COLOR]
                DoEvents
                i = i + 1
                [COLOR=darkblue]If[/COLOR] Found.Offset(i).Value <> "" [COLOR=darkblue]Then[/COLOR] strStuff = strStuff & " " & Found.Offset(i).Value
            [COLOR=darkblue]Loop[/COLOR] [COLOR=darkblue]Until[/COLOR] i = 100 [COLOR=darkblue]Or[/COLOR] Found.Offset(i) [COLOR=darkblue]Like[/COLOR] "Quality*"
            cell.Offset(, 2).Value = strStuff
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
    [COLOR=darkblue]Next[/COLOR] cell
    
    Application.ScreenUpdating = [COLOR=darkblue]True[/COLOR]
    
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]

I just had to tweak it a bit and it worked perfectly! Thank you for making this a great first experience at MrExcel.com

-Homeskool