Macro to look up for a set list of words from one sheet in another sheet

[Legacy 290164]

Hello,

I am trying to achieve something similar to a Vlookup I guess.

I want my code to:

1. Select first cell of range in spreadsheet 2
2. Find it in spreadsheet 1
3. If found highlight row and paste cell value in adjacent cell
4. Move down one cell in range
5. Loop until end of range

Here is what I have come up with reading various bits of this forum:

Sub Lookupforalistofwords()
'
'
'
Dim c As Range
Dim i As Long
Dim x As Long
Dim y As Variant
Dim z As Worksheet
Dim a As Variant


i = 0
x = Selection.Rows.Count
y = Selection.Cells(1, 1)
Set z = ActiveWorkbook.Sheets(1)
Set a = ActiveWorkbook.Sheets(2).Cells(1, 1)


While (i <= x)
Cells.Find(What:=y, After:=a, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveRow.Interior.ColorIndex = 36
ActiveCell.End(xlToRight).PasteSpecial xlPasteValues
y = y.Offset(1)


Wend


End Sub


I am fairly confident I have done a lot wrong and I am really keen to learn from my mistakes.

Any help appreciated!

Natacha.

 

[Comfy]

Just use a VLookup with conditional formatting, there is no need for VBA.

 

[JackDanIce]

Welcome to the board.

Can you:

- State the exact names of both spreadsheets.
- The exact range address of the values to look up in spreadsheet 2
- "Find it in spreadsheet 1" Is this in a specific column or the whole sheet?
- "Highlight the row and paste cell value into adjacent cell"
Will the adjacent cell ALWAYS be in the same column or anywhere in the spreadsheet1?
Do you want to cells next to each other with the same value in spreadsheet1? E.g. cell with matching value is found in A12, so paste that value into B12, i.e. B12 has same value as A12?

 

[Legacy 290164]

Just use a VLookup with conditional formatting, there is no need for VBA.

Yes, but the match is nowhere near partial.

I mean, I could have apple in my range and Superb Incredible apples test.

There is no way vlookup will find that, I mean I do have the need for this code. Maybe the fuzzy add-in could help but I am using Excel 2007.

Thanks for your reply anyway.

Welcome to the board.

Can you:

- State the exact names of both spreadsheets.
- The exact range address of the values to look up in spreadsheet 2
- "Find it in spreadsheet 1" Is this in a specific column or the whole sheet?
- "Highlight the row and paste cell value into adjacent cell"
Will the adjacent cell ALWAYS be in the same column or anywhere in the spreadsheet1?
Do you want to cells next to each other with the same value in spreadsheet1? E.g. cell with matching value is found in A12, so paste that value into B12, i.e. B12 has same value as A12?

- Sheet1 and Sheet2.
- It is going to vary but I guess I could make it consistent and just use A:A
- Column A.
- Always in the same column
Yes but A12 will not necessarily equal B12, I guess I missed the fact that find would not look for the string inside the cell or will it?

I am not sure whether I am being clear enough. I am trying though.

Thanks a lot, I have been reading the board for a while but I thought I might as well join!

 

[JackDanIce]

Try (on a copy of your workbook):

Sub Macro1()

Dim x As Long, y As Long
Dim rng1 As Range, rng2 As Range
Dim ws1 As Worksheet: Set ws1 = Sheets("Sheet1")
Dim ws2 As Worksheet: Set ws2 = Sheets("Sheet2")

Application.ScreenUpdating = False
y = ws1.Range("A" & Rows.Count).End(xlUp).Row

For Each rng1 In ws2.Range("A1:A" & Rows.Count).End(xlUp)
    On Error Resume Next
    Set rng2 = ws1.Range("A1:A" & y).Find(what:=rng1.Value, LookIn:=xlValues, lookat:=xlPart)
    On Error GoTo 0
    If Not rng2 Is Nothing Then
        With rng2
            .EntireRow.Interior.ColorIndex = 6
            .Offset(, 1).Value = rng.Value
        End With
        Set rng2 = Nothing
    End If
Next rng1
        
Application.ScreenUpdating = True

End Sub

 

[Legacy 290164]

Try (on a copy of your workbook):

Sub Macro1()

Dim x As Long, y As Long
Dim rng1 As Range, rng2 As Range
Dim ws1 As Worksheet: Set ws1 = Sheets("Sheet1")
Dim ws2 As Worksheet: Set ws2 = Sheets("Sheet2")

Application.ScreenUpdating = False
y = ws1.Range("A" & Rows.Count).End(xlUp).Row

For Each rng1 In ws2.Range("A1:A" & Rows.Count).End(xlUp)
    On Error Resume Next
    Set rng2 = ws1.Range("A1:A" & y).Find(what:=rng1.Value, LookIn:=xlValues, lookat:=xlPart)
    On Error GoTo 0
    If Not rng2 Is Nothing Then
        With rng2
            .EntireRow.Interior.ColorIndex = 6
            .Offset(, 1).Value = rng.Value
        End With
        Set rng2 = Nothing
    End If
Next rng1
        
Application.ScreenUpdating = True

End Sub

Thanks for this!

Please find the set of data I used and for which the code above didn't work.

Sheet 1:
Column A
[TABLE="width: 348"]
<tbody>[TR]
[TD]Clothes > Dresses > Tunics[/TD]
[/TR]
[TR]
[TD]Clothes > Jacket & Coats[/TD]
[/TR]
[TR]
[TD]Clothes > Jeans[/TD]
[/TR]
[TR]
[TD]Clothes > Jumpsuits & Playsuits[/TD]
[/TR]
</tbody>[/TABLE]


Sheet 2:

Column A
Dress
Jacket
Jean
Suit

I tried to do it the other way around (and have the data in sheet1 A in sheet2A) but still didn't work.