Macro: Find & Replace with Offset?

[med365]

I need to Find & Replace based on ID#'s between two Sheets. My ID#'s are in column "A", but the data that needs to change is in column "FirstName". I've found a Macro that works except that it changes the ID# instead of the FirstName.

Here is the code:

Sub multiFindNReplace()
    Dim myList, myRange
    Set myList = Sheets("Sheet2").Range("A2:A3")
    Set myRange = Sheets("sheet1").Range("A2:A28")
    For Each cel In myList.Columns(1).Cells
        myRange.Replace what:=cel.Value, replacement:=cel.Offset(0, 1).Value
    Next cel
    
End Sub

Example image:

So, in Sheet1 the FirstName "JAMES" should change to "Jimmy", and "RONALD" should change to "Ronny" based off of finding the correct ID#.

However, the current code changes the ID# instead.

 

[hiker95]

med365,


Welcome to the MrExcel forum.


Sample worksheets:

Excel Workbook
	A	B
1	Leadid	FirstName
2	11830-SMG	Jimmy
3	11746-SMG	Ronny
4
Sheet2

Excel Workbook
	A	B	C
1	Leadid	ClientName	FirstName
2	11830-SMG		JAMES
3
4
5
6
7
8	11746-SMG		RONALD
9
Sheet1

After the macro:

Excel Workbook
	A	B	C
1	Leadid	ClientName	FirstName
2	11830-SMG		Jimmy
3
4
5
6
7
8	11746-SMG		Ronny
9
Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Option Explicit
Sub multiFindNReplaceV2()
' hiker95, 12/19/2011
' http://www.mrexcel.com/forum/showthread.php?t=600081
' cross posted here: http://www.excelforum.com/excel-programming/806350-multifindnreplace-macro.html
Dim w1 As Worksheet, w2 As Worksheet
Dim c As Range, fr As Long
Application.ScreenUpdating = False
Set w1 = Worksheets("Sheet1")
Set w2 = Worksheets("Sheet2")
For Each c In w2.Range("A2:A3")
  fr = 0
  On Error Resume Next
  fr = Application.Match(c, w1.Columns(1), 0)
  On Error GoTo 0
  If fr <> 0 Then
    w1.Cells(fr, 3).Value = c.Offset(, 1).Value
  End If
Next c
Application.ScreenUpdating = True
End Sub

Then run the multiFindNReplaceV2 macro.

 

[AlphaFrog]

[color=darkblue]Sub[/color] multiFindNReplace()
    [color=darkblue]Dim[/color] myList [color=darkblue]As[/color] Range, lr [color=darkblue]As[/color] [color=darkblue]Long[/color], cel [color=darkblue]As[/color] Range
    
    [color=darkblue]Set[/color] myList = Sheets("Sheet2").Range("A2:A3")
    
    Application.ScreenUpdating = [color=darkblue]False[/color]
    [color=darkblue]With[/color] Sheets("Sheet1")
        lr = .Range("A" & Rows.Count).End(xlUp).Row
        [color=darkblue]For[/color] [color=darkblue]Each[/color] cel [color=darkblue]In[/color] myList
            [color=darkblue]If[/color] WorksheetFunction.CountIf(.Range("A2:A" & lr), cel.Value) [color=darkblue]Then[/color]
                .Range("A1:A" & lr).AutoFilter Field:=1, Criteria1:=cel.Value
                .Range("C2:C" & lr).SpecialCells(xlCellTypeVisible).Value = cel.Offset(, 1).Value
            [color=darkblue]End[/color] [color=darkblue]If[/color]
        [color=darkblue]Next[/color] cel
        .AutoFilterMode = [color=darkblue]False[/color]
    [color=darkblue]End[/color] [color=darkblue]With[/color]
    Application.ScreenUpdating = [color=darkblue]True[/color]
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]

 

[Alphacsulb]

Hello, I figured I would piggyback off this thread since my question is similar.

Using the same scenario above, but instead of offsetting 2 columns to the right and paste the value I would like to offset 7 rows down (Same Column) and paste the value.

Any leads would be appreciated. Thank you.