More help on Find and Replace from one sheet to the next

I'm trying to find and replace cells by looking at a value from one sheet, and replacing it with a value from another sheet.
I'm currently modifying a code from my last thread by jolivanes (thank you!)

I think I'm running into an issue using this code because some of the cells are combined, so it's not properly searching down the column. But I'm not sure.

The code should:
1. Find a name from (Sheet 1 column A) in (Sheet 2 column E)
2. If it's found, then replace (Sheet 2 Column K, same row) with the value from (Sheet 1 column B, same row)

Dim s1 As Worksheet
Dim s2 As Worksheet
Dim al As Range

Set s1 = Worksheets("Sheet1")
Set s2 = Worksheets("Sheet2")

        For Each al In s1.Range("A2:A" & s1.Cells(Rows.Count, 1).End(xlUp).Row)
            If WorksheetFunction.CountIf(s2.Range("E2:E" & s2.Cells(Rows.Count, 1).End(xlUp).Row), al.Value) <> 0 Then
                s2.Range("E2:E" & s2.Cells(Rows.Count, 1).End(xlUp).Row).Find(al.Value, , , 1).Offset(, 4).Value = al.Offset(, 1).Value
            End If
        Next al

I've attached a sample worksheet to give you an idea of how the values might look.

Originally Posted by maras_mak

Test my solution.

Thanks Mara. The solution works on the sample sheet but didn't work on my actual one. The only thing I changed was all instances of (s2) to (s4) and Set s4 as Worksheets("Sheet4")

I get a "Runtime Error '9': Subscript out of range" on the highlighted line.

    Set d = CreateObject("scripting.dictionary")
    Set s1 = Worksheets("Sheet1")
    Set s2 = Worksheets("Sheet2")
    With s1
        lr = .Cells(Rows.Count, "A").End(xlUp).Row
        a1() = .Range("A1:B" & lr).Value
        If IsArray(a1) Then
            With s2
                lr = .Cells(Rows.Count, "E").End(xlUp).Row
                If lr > 1 Then
                    a2 = .Range("E1:K" & lr).Value
                    For i = 1 To UBound(a1)
                        d(a1(i, 1)) = a1(i, 2)
                    Next
                    For i = 1 To UBound(a2)
                        If d.exists(a2(i, 1)) Then _
                                    a2(i, 7) = d.Item(a2(i, 1))
                    Next
                End If
                .[K1].Resize(UBound(a2)) = Application.Index(a2, 0, 7)
            End With
        End If
    End With
    Set s1 = Nothing
    Set s2 = Nothing

I forgot to mention that the values in Sheet 1 may have random blanks or missing values in it. I'm not sure if that will cause the code to fail.

Ok here's a better sample workbook.

Thank you very much!

You could try this (use from either sheet)

Sub Maybe()
Dim sh1 As Worksheet, sh2 As Worksheet, i As Long
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet4")
For i = 2 To sh1.Cells(Rows.Count, 1).End(xlUp).Row
    If WorksheetFunction.CountIf(sh2.Range("E4:E" & sh2.Cells(Rows.Count, 5).End(xlUp).Row), sh1.Cells(i, 1).Value) <> 0 Then
        sh2.Range("E4:E" & sh2.Cells(Rows.Count, 5).End(xlUp).Row).Find(sh1.Cells(i, 1).Value, , , 1).Offset(, 6).Value = sh1.Cells(i, 1).Offset(, 1).Value
    End If
Next i
End Sub

Thank you! The solution worked perfectly!