Lookup in other sheet VBA

[billmark]

Hi
I have the codes to perform the following:
1. I have data in sheet1
2. I have a range of numbers in sheet3, from A1 to A10
3. If the data in column1 of sheet1 matches to that in A1 to A10 in sheet3, then add "S" to the end of the data in column27 and then make column26 the same as column27.

Please advise how to fix as it doesn't work

QUOTE

Sub sbNameRange()
    Dim WB As Workbook
    Dim dataSH As Worksheet, lookupSHsub As Worksheet
    Dim dataRng As Range, lookupRngsub As Range
    Dim rCell As Range
    Dim Res As Variant
    Dim LRow As Long
    Dim i As Integer
    


    Const sDataSheet As String = "Sheet1"
    Const sLookupSheet3 As String = "Sheet3"
    Const sLookupRange3 As String = "A1:A10"
    
       
   
    
    Set WB = ThisWorkbook


    With WB
        Set dataSH = .Sheets(sDataSheet)
        Set lookupSHsub = .Sheets(sLookupSheet3)
    End With


    Set lookupRngsub = lookupSHsub.Range(sLookupRange3)




    With dataSH
        LRow = .Cells(Rows.Count, "A").End(xlUp).Row
        Set dataRng = .Range("A1:A" & LRow)
    End With


    
   i = 2
  For Each rCell In dataRng.Cells
        With rCell
            Res = Application.Match(.Value, lookupRngsub, 0)
            If Not IsError(Res) _
                            And .Offset(0, 0).Value = sLookupRange3 Then
                Cells(i, 27) = Cells(i, 27) & " " & "S"
                Cells(i, 26) = Cells(i, 27)
            End If
            
            
            
        End With
    Next rCell
    
End Sub

UNQUOTE

 

[Trebor76]

Hi billmark,

Try this:

Option Explicit
Sub Macro1()

    Dim rngMyCell As Range
    Dim lngLastRow As Long
    Dim varResult As Variant
    
    Application.ScreenUpdating = False
    
    lngLastRow = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
    
    For Each rngMyCell In Sheets("Sheet1").Range("A1:A" & lngLastRow)
        If Len(rngMyCell) > 0 Then
            varResult = Evaluate("VLOOKUP(""" & rngMyCell & """,Sheet3!$A$1:$A$10,1,0)")
            If IsError(varResult) = False Then
                With Sheets("Sheet1")
                    .Range("AA" & rngMyCell.Row).Value = .Range("AA" & rngMyCell.Row).Value & "S"
                    .Range("Z" & rngMyCell.Row).Value = .Range("AA" & rngMyCell.Row).Value
                End With
            End If
        End If
    Next rngMyCell
    
    Application.ScreenUpdating = True

End Sub

Regards,

Robert

 

[billmark]

Hi Robert
Thanks

However, it doesn't work. When I placed the cursor on varResult, it showed varResult=Error 2042.

Please help.

Regards

 

[Fluff]

Please advise how to fix as it doesn't work

If we knew what "doesn't work" meant then we may be able to help.

 

[billmark]

Hi
No change in columns 26 and 27 after running the code, ie "S" is not added to end of the data in column27 and thus column26 the same as column27

 

[Fluff]

How about

For Each rCell In DataRng.Cells
   With rCell
      Res = Application.Match(.Value, lookupRngsub, 0)
      If Not IsError(Res) And .Value = sLookupRange3 Then
         .Offset(, 26).Value = .Offset(, 26).Value & " S"
         .Offset(, 25).Value = .Offset(, 26).Value
      End If
   End With
Next rCell

 

[billmark]

"S" is still not added. But I remove this condition "And .Value = sLookupRange3", it works.

Anyway, thanks

 

[Fluff]

You're welcome

 

[Trebor76]

However, it doesn't work.

That's odd - it worked for me I agree with Fluff - we can't offer a solution if we don't know what's broken.

When I placed the cursor on varResult, it showed varResult=Error 2042.

That's expected. It just means there was no match from the VLOOKUP formula in the code so the code goes to the next cell. If there are no exact matches in column A of Sheet1 to cells A1:A10 of Sheet3 nothing will happen. Put the VLOOKUP formula in the code I've written into a sheet and see if any matches are returned.

If you step through the code (by pressing F8) it may give you a better idea of what's happening though as you've been able to get Fluff's nifty code to work that's great.