VBA to replace with multiple conditions

[nicolas877]

Hi forum, i need a vba code to replace text following multuple criteria in a sheet like this
Before
Date Name
Week 1 Tom
Week 1 Tom
Week 2 kate
Week 4 Tom

To
Date Name
Week 1 Tom Hanks
Week 1 Tom Hanks
Week 2 kate Smith
Week 4 Tom Miller

Using this key
Week 1 Tom Hanks
Week 2 Kate Smith
Week 4 Tom Miller

The real sheet has like 15000 diferents rows and multiple names/dates, i tried using this code but only works with one condition (like replace Tom with Tom Hanks, but i also the week criteria)

Sub MultiFindNReplace() 
Dim Rng As Range 
Dim InputRng As Range, ReplaceRng As Range 
xTitleId = "KutoolsforExcel" 
Set InputRng = Application.Selection
 Set InputRng = Application.InputBox("Original Range ", xTitleId, InputRng.Address, Type:=8) 
Set ReplaceRng = Application.InputBox("Replace Range :", xTitleId, Type:=8) 
Application.ScreenUpdating = False 
For Each Rng In ReplaceRng.Columns(1).Cells    
InputRng.Replace what:=Rng.Value, replacement:=Rng.Offset(0, 1).Value, Lookat:=xlWhole 
Next
Application.ScreenUpdating = True 
End Sub

 

[bebo021999]

How the data look like? Try to attach image/screenshot/XL2BB

 

[rlv01]

One way.

Sub MultiFindNReplace()
    Dim SearchArray As Variant, ReplaceArray As Variant, SearchTerm As String, ReplaceTerm As String, I As Long

    SearchArray = Array("Week 1 Tom", "Week 2 kate", "Week 4 Tom")
    ReplaceArray = Array("Week 1 Tom Hanks", "Week 2 Kate Smith", "Week 4 Tom Miller")

    Application.ScreenUpdating = False
    With ActiveSheet.UsedRange
        For I = LBound(SearchArray) To UBound(SearchArray)
            SearchTerm = SearchArray(I)
            ReplaceTerm = ReplaceArray(I)
            .Replace What:=SearchTerm, Replacement:=ReplaceTerm, Lookat:=xlWhole
        Next I
    End With
    Application.ScreenUpdating = True
End Sub

 

[nicolas877]

How the data look like? Try to attach image/screenshot/XL2BB

Like this

Date	Name
Week 1	Tom
Week 1	Tom
Week 2	Kate
Week 4	Tom

I tried to made a selection array like the 1 condition replace vba posted to no success

 

[rlv01]

Assuming that what you posted above about what the data looks like, and where it is stored means this:

Book1
	A	B
1	Date	Name
2	Week 1	Tom
3	Week 1	Tom
4	Week 2	kate
5	Week 4	Tom
Sheet3

Then here is one way:

Sub SearchReplace()
    Dim WS As Worksheet
    Dim CellRange As Range
    Dim R As Range
    Dim SearchTerm As String

    Set WS = ActiveSheet

    With WS
        Set CellRange = .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row)    'last cell in column w/data
    End With

    For Each R In CellRange
        SearchTerm = Trim(UCase(R.Value)) & " " & Trim(UCase(R.Offset(0, 1).Value))
        Select Case SearchTerm
        Case "WEEK 1 TOM"
            R.Offset(0, 1).Value = "Tom Hanks"
        Case "WEEK 2 KATE"
            R.Offset(0, 1).Value = "Kate Smith"
        Case "WEEK 4 TOM"
            R.Offset(0, 1).Value = "Tom Miller"
        End Select
    Next R
End Sub

It will produce this result:

Book1
	A	B
1	Date	Name
2	Week 1	Tom Hanks
3	Week 1	Tom Hanks
4	Week 2	Kate Smith
5	Week 4	Tom Miller
Sheet3