Macro to find Like and paste values

[AFANPQ]

Hello,

This is my first post. I am fairly new to VBA and this has me in over my head. I have scoured the internet to try and find the answer for my issue. I am trying to write a script to reference column "S" by row ("S2", "S3", "S4" to the end of the list) and find Like values in Ranges "D2:D500", "F2:F500", and "M2:M500". If matches are found I'd like to paste all of the matches into column "A".

Example:
A ............ D F ........ M.............. S
Lettuce, Onions Mayo Pickles Onions Lettuce, Onions Mayo Pickles Burger w/ Pickles Pickles
Burger w/ Pickles

I'm not sure if I'm making total sense. Please ask if you need clarity!

 

[JLGWhiz]

Just to be clear, are you looking for stand alone values (Not embedded with other text) in columns D, F and M, or will the searched text be embedded with other text in the same cell?
Assuming the are stand alone values, try this:

Sub t()
Dim rng As Range, fn As Range, c As Range
Set rng = Union(Range("D2:D500"), Range("F2:G500"), Range("M2:M500"))
    For Each c In Range("S2", Cells(Rows.Count, "S").End(xlUp))
        Set fn = rng.Find(c.Value, , xlValues, xlWhole)
            If Not fn Is Nothing Then
                Cells(Rows.Count, 1).End(xlUp)(2) = fn.Value
            End If
    Next
End Sub

 

[AFANPQ]

Good question! Thank you for asking. It will be embedded within other text.

 

[JLGWhiz]

Good question! Thank you for asking. It will be embedded within other text.

Then we can try this modification to the other code and see if it yields the results you want. If not, then we can go another route which will take longer to run.

Sub t()
Dim rng As Range, fn As Range, c As Range
Set rng = Union(Range("D2:D500"), Range("F2:G500"), Range("M2:M500"))
    For Each c In Range("S2", Cells(Rows.Count, "S").End(xlUp))
        Set fn = rng.Find(c.Value, , xlValues, xlPart)
            If Not fn Is Nothing Then
                Cells(Rows.Count, 1).End(xlUp)(2) = fn.Value
            End If
    Next
End Sub

 

[AFANPQ]

My greatest apologies, JLGWhiz. I have realized I wasn't fully explicit with what the code should accomplish.
The code should look for related values from Column S within the aforementioned columns and return the corresponding row values from Column D to Column A in the form of a list within each cell.

 

[AFANPQ]

Funny enough, I had already made this change. I am like a foreigner in a country that speaks the native tongue in a broken fashion when it comes to VBA

 

[JLGWhiz]

This would be much easier if I could see the worksheet. I think I am shooting in the dark. See if this give what you need.

Sub t()
Dim rng As Range, fn As Range, c As Range, r As Range
Set rng = Union(Range("D2:D500"), Range("F2:G500"), Range("M2:M500"))
    For Each c In Range("S2", Cells(Rows.Count, "S").End(xlUp))
        For Each r In rng
            If InStr(r.Value, c.Value) > 0 Then
                Cells(Rows.Count, 1).End(xlUp)(2) = Cells(r.Row, "D").Value
            End If
        Next
    Next
End Sub

 

[AFANPQ]

I'd say that sharing the ws would be highly helpful. I had a couple interns write these macros to find project relationships by listing those beside each project in question. It is a huge load of code. I am attempting to rewrite most of it to accomplish easier break/fix and to augment the code to do more. Below is a bit of a visual and some explanation.
[TABLE="width: 500"]
<tbody>[TR]
[TD]"A"
Potential Relationships [/TD]
[TD]"D"
Project Name[/TD]
[TD] "F" "M"
<strike></strike>
[/TD]
[TD]"S"

Search Criteria(Column "S")
[/TD]
[/TR]
[TR]
[TD]Project Surfing<strike></strike>
Project Skydive
[/TD]
[TD]Project Fun<strike></strike>
[/TD]
[TD]These columns include applications/software/hardware and proj. description <strike></strike>
[/TD]
[TD]Project Alpha
[/TD]
[/TR]
[TR]
[TD]Project Beta
Sunset
[/TD]
[TD]Project Alpha
[/TD]
[TD][/TD]
[TD]Project Beta<strike></strike>
[/TD]
[/TR]
[TR]
[TD]<strike></strike>
[/TD]
[TD][/TD]
[TD][/TD]
[TD]Project Fun<strike></strike>
[/TD]
[/TR]
[TR]
[TD]<strike></strike>
[/TD]
[TD][/TD]
[TD][/TD]
[TD]Project Surfing<strike></strike><strike></strike>
[/TD]
[/TR]
[TR]
[TD]<strike></strike>
[/TD]
[TD][/TD]
[TD][/TD]
[TD]Project Skydive <strike></strike>
[/TD]
[/TR]
[TR]
[TD]<strike></strike>
[/TD]
[TD][/TD]
[TD][/TD]
[TD] Sunset
[/TD]
[/TR]
</tbody>[/TABLE]

 

[JLGWhiz]

It looks like you would only want to search columns F and M and then return the corresponding value from column D. So in my suggested code you would take column D out of the Union range to get the appropriate results.

Sub t()
Dim rng As Range, fn As Range, c As Range, r As Range
Set rng = Union(Range("F2:G500"), Range("M2:M500"))
    For Each c In Range("S2", Cells(Rows.Count, "S").End(xlUp))
        For Each r In rng
            If InStr(r.Value, c.Value) > 0 Then
                Cells(Rows.Count, 1).End(xlUp)(2) = Cells(r.Row, "D").Value
            End If
        Next
    Next
End Sub

I am assuming that the column S values would also appear in the columns F and M values.

 

[AFANPQ]

This code is working. But it's not listing every match within the corresponding cells. I'm sure it's my fault for not giving the best detail and examples.
I'm not sure how I can express exactly what I'm looking for but I'll give it a go...

Column "S" holds the search criteria.... I need the code to search the aforementioned columns to find the partial value of "S2". Let's say the value is found in 3 different rows (7, 13 and 27). The projects identified in Column "D" for each of these rows would be listed within Cells "A7", "A13" and "A27". However, "A7" would not be on the list in row 7 column A because it is the return value on that row and doesn't need to be listed in the same row.

After the "S2" search completes the code would continue "S3", "S4" to the end of Column S

Column A Column D

Row 7 Project13 Project7
Project27


I hate to be a pain. Thank you for giving this a try!