Find & Replace cells

[zaska]

Hi ,

I have the following table with new names and old names and i would like to find and replace all the names in the workbook (Sheet1,2,3....) with reference to this table. The table is stored in "Rename" sheet.

<table border="0" cellpadding="0" cellspacing="0" width="180"><col style="mso-width-source:userset;mso-width-alt:3766;width:77pt" width="103"> <col style="mso-width-source:userset;mso-width-alt:2816;width:58pt" width="77"> <tbody><tr style="height:15.0pt" height="20"> <td style="height:15.0pt;width:77pt;font-size:11.0pt; color:white;font-weight:700;text-decoration:none;text-underline-style:none; text-line-through:none;font-family:Calibri;border-top:.5pt solid #95B3D7; border-right:none;border-bottom:.5pt solid #95B3D7;border-left:.5pt solid #95B3D7; background:#4F81BD;mso-pattern:#4F81BD none" height="20" width="103">A1
</td> <td style="width:58pt;font-size:11.0pt;color:white;font-weight:700; text-decoration:none;text-underline-style:none;text-line-through:none; font-family:Calibri;border-top:.5pt solid #95B3D7;border-right:.5pt solid #95B3D7; border-bottom:.5pt solid #95B3D7;border-left:none;background:#4F81BD; mso-pattern:#4F81BD none" width="77">B1</td> </tr> <tr style="height:15.0pt" height="20"> <td style="height:15.0pt;font-size:11.0pt;color:black;font-weight: 400;text-decoration:none;text-underline-style:none;text-line-through:none; font-family:Calibri;border-top:.5pt solid #95B3D7;border-right:none; border-bottom:.5pt solid #95B3D7;border-left:.5pt solid #95B3D7;background: #DCE6F1;mso-pattern:#DCE6F1 none" height="20">OldName</td> <td style="font-size:11.0pt;color:black;font-weight:400;text-decoration:none; text-underline-style:none;text-line-through:none;font-family:Calibri; border-top:.5pt solid #95B3D7;border-right:.5pt solid #95B3D7;border-bottom: .5pt solid #95B3D7;border-left:none;background:#DCE6F1;mso-pattern:#DCE6F1 none">NewName</td> </tr> <tr style="height:15.0pt" height="20"> <td style="height:15.0pt;font-size:11.0pt;color:black;font-weight: 400;text-decoration:none;text-underline-style:none;text-line-through:none; font-family:Calibri;border-top:.5pt solid #95B3D7;border-right:none; border-bottom:.5pt solid #95B3D7;border-left:.5pt solid #95B3D7" height="20">APPLE</td> <td style="font-size:11.0pt;color:black;font-weight:400;text-decoration:none; text-underline-style:none;text-line-through:none;font-family:Calibri; border-top:.5pt solid #95B3D7;border-right:.5pt solid #95B3D7;border-bottom: .5pt solid #95B3D7;border-left:none">STAPLE</td> </tr> <tr style="height:15.0pt" height="20"> <td style="height:15.0pt;font-size:11.0pt;color:black;font-weight: 400;text-decoration:none;text-underline-style:none;text-line-through:none; font-family:Calibri;border-top:.5pt solid #95B3D7;border-right:none; border-bottom:.5pt solid #95B3D7;border-left:.5pt solid #95B3D7;background: #DCE6F1;mso-pattern:#DCE6F1 none" height="20">BALL</td> <td style="font-size:11.0pt;color:black;font-weight:400;text-decoration:none; text-underline-style:none;text-line-through:none;font-family:Calibri; border-top:.5pt solid #95B3D7;border-right:.5pt solid #95B3D7;border-bottom: .5pt solid #95B3D7;border-left:none;background:#DCE6F1;mso-pattern:#DCE6F1 none">BAT</td> </tr> <tr style="height:15.0pt" height="20"> <td style="height:15.0pt;font-size:11.0pt;color:black;font-weight: 400;text-decoration:none;text-underline-style:none;text-line-through:none; font-family:Calibri;border-top:.5pt solid #95B3D7;border-right:none; border-bottom:.5pt solid #95B3D7;border-left:.5pt solid #95B3D7" height="20">CAT</td> <td style="font-size:11.0pt;color:black;font-weight:400;text-decoration:none; text-underline-style:none;text-line-through:none;font-family:Calibri; border-top:.5pt solid #95B3D7;border-right:.5pt solid #95B3D7;border-bottom: .5pt solid #95B3D7;border-left:none">DOG</td> </tr> <tr style="height:15.0pt" height="20"> <td style="height:15.0pt;font-size:11.0pt;color:black;font-weight: 400;text-decoration:none;text-underline-style:none;text-line-through:none; font-family:Calibri;border-top:.5pt solid #95B3D7;border-right:none; border-bottom:.5pt solid #95B3D7;border-left:.5pt solid #95B3D7;background: #DCE6F1;mso-pattern:#DCE6F1 none" height="20">HONDA</td> <td style="font-size:11.0pt;color:black;font-weight:400;text-decoration:none; text-underline-style:none;text-line-through:none;font-family:Calibri; border-top:.5pt solid #95B3D7;border-right:.5pt solid #95B3D7;border-bottom: .5pt solid #95B3D7;border-left:none;background:#DCE6F1;mso-pattern:#DCE6F1 none">SUZUKI</td> </tr> </tbody></table>
The range of old names and new names will not be greater than 2000

Can any one help me with VBA?

Thank you

 

[villy]

Try This then:

Sub ChangeData()
Application.ScreenUpdating = False
Application.EnableEvents = False
With WorksheetFunction.Application
Dim sht As Worksheet
Set sh = Sheets("Table")
Set myRng = sh.Range("A:B") 'Change range to suit
Set myR = sh.Range("A:A") 'Change range to suit
        For j = 2 To Sheets.Count
        lrow = Sheets(j).Cells(Rows.Count, "A").End(xlUp).Row
            For i = 2 To lrow
                If Not IsError(.Index(myRng, .Match(Sheets(j).Range("A" & i), myR, 0), 1)) = True Then
                    Sheets(j).Range("A" & i).Value = .Index(myRng, .Match(Sheets(j).Range("A" & i), myR, 0), 2)
                End If
            Next
        Next
Application.ScreenUpdating = True
Application.EnableEvents = True
End With
End Sub

 

[zaska]

Thanks a lot Villy... I tested the code and it worked like a charm.

If possible could you please explain the code in simple language. I didnot understand terms like .Enable Events = false , R , .Index , .Match

Have a nice day.

 

[villy]

Hi, sorry for late response I've been on a busy holiday.

.Enable Events when false stops all the event temporarily before your code is done running then you have to set to true to reset it and works as normal..
.index and .Match is the same as in Excel function the same use that's why if you will notice I used application.Worksheetfunction meaning you are telling the code that you want to use the built in excel function. try to use worksheetfunction(.) and it will show you the list of excel functions you can use in VBA.
Thanks

 

[Legacy 167133]

Hello Villy,

I like your coding, and have tweaked your first code, you offerd to Zazka to colour and activate the cells referred to by the InputBox, and added a message that "Empy" entries are not allowed.

Sub ChangeData()
Application.ScreenUpdating = True
Application.EnableEvents = False
With WorksheetFunction.Application
Set myR = Range("A:A") 'Change range to suit
lrow = Cells(Rows.Count, "A").End(xlUp).Row
Search:
        prompt = "Enter Reference of Column 'A' to change data in Column 'B' "
        Title = "Change Data in Column 'B' "
        updrec = InputBox(prompt, Title)
        If StrPtr(updrec) = 0 Then
            Exit Sub
        ElseIf updrec = "" Then
            Exit Sub
        Else
            For i = 2 To lrow
                If Not IsError(.Index(myR, .Match(updrec, myR, 0), 1)) = True Then
                            Range("B" & .Match(updrec, myR, 0)).Activate
                            Range("B" & .Match(updrec, myR, 0)).Interior.ColorIndex = 3
                            Range("A" & .Match(updrec, myR, 0)).Interior.ColorIndex = 5
                            updval = InputBox("Current Data: " & Range("A" & .Match(updrec, myR, 0)) & _
                            vbNewLine & "Enter New Data:", "New Data")
                
                    If updval = "" Then
                    MsgBox "No 'Empty Entries' Allowed", vbOKOnly, ("Input Control")
                    Range("A" & .Match(updrec, myR, 0)).Interior.ColorIndex = 0
                    Range("B" & .Match(updrec, myR, 0)).Interior.ColorIndex = 0
                    End If
                    If updval <> "" Then
                    Range("B" & .Match(updrec, myR, 0)).Value = updval
                    MsgBox "Data: " & "[" & updrec & "]" & " successfully changed to " & _
                                "[" & updval & "]", vbInformation + vbOKOnly, "Update"
                    Range("A" & .Match(updrec, myR, 0)).Interior.ColorIndex = 0
                    Range("B" & .Match(updrec, myR, 0)).Interior.ColorIndex = 0
                    End If
                    Exit For
                Else
                    ask = MsgBox("Data not found. Do you want to search another?", vbYesNo, "No Data Found")
                    If ask = vbYes Then
                        GoTo Search
                    Else: Exit For
                    End If
                
                End If
            Next
        End If
Application.ScreenUpdating = True
Application.EnableEvents = True
End With
End Sub

Do you like?

 

[villy]

Swem-Jannie:

It is nice..

 

[zaska]

Thank you Villy and Jannie