Find and Replace based on a List

[naungsai]

Dear Friends

In my office, I have to consolidate the data sent by different townships. The name of towns in these field data are inconsistent. I have to correct these town name into standard one.
At this point I have written a macro (find then replace). My current macro is, I think, only good for few towns. When the error of those towns name is hundreds, I think should rather look up from a table.
I will create a table for towns.

ColumnA ColumnB
Lonodn London
Londno London
Lodon London
NewYork New York
Nwe York New York
Parsi Paris
Piars Paris
Pasri Paris
Tokoy Tokyo
Tooky Tokyo
... ...
... ...

In my table, ColumnA is wrong town names. ColumnB is right town name.
I want to get a macro for finding the names in columnA in my whole Excel Workbook, then replace with the correct names from ColumnB.

Can somebody help me please?

Thanks in advance.

Sai

 

[AD_Taylor]

I've actually done something like this before so:

Sub prTest()

    Dim ws As Worksheet
    Dim rngFind As Range
    Dim strFind As String
    Dim strReplace As String
    
    Set ws = Worksheets("LookUpTable")
    strFind = "Lonodn"
    
    Set rngFind = ws.Range("A:A").Find(strFind, LookAt:=xlWhole)
    If Not rngFind Is Nothing Then
        strReplace = rngFind.Offset(0, 1).Value
    End If
    
    'strReplace should now equal London
    '(Based on your lookup table)

End Sub

Set the ws variable equal to the name of your lookup sheet. Then we see if the value you are looking for (strFind) exists in Column A of that sheet.

If it does we set strReplace to be the value of the column next to it. You can then use strReplace in the same way as normal to replace your existing data.

If you want any help integrating it with your current code, let me know.

Hope this helps!
Adam

Welcome to the forum by the way!

 

[naungsai]

Dear Adam

Thanks for your prompt response.

I think, I may need more clarification of my question.

The excel workbook send from the field office has many sheet. Each sheet has a column of "TOWN". Many of the name of "TOWN" need to be corrected.

I shall have a list of Wrong and Correct towns in another excel workbook which will also be embedded a VBA code.

After customizing the menu tab of my excel with this find and replace macro, I could run it in any workbook.

Thanks in advanced.

Sai

 

[AD_Taylor]

So to make sure I've got this right:

You'll have 1 workbook which has the table of misspelt names (in Column A) with their correct versions (in Column B).
This workbook will also have the code that needs to be written.

When you get a file in from the field office, it will need to be corrected according to this list. It is not just one sheet in this file, but all sheets that should be corrected. The column to be corrected on each sheet has the heading 'TOWN'.

A couple of questions then:

Will you open the field office file, then open the macro file, make sure that the field office file is active and then run the macro?

What exactly do you mean by customising the menu tab to run the macro?

Will the 'TOWN' column always be the same column, such as always Column D, or will it change across each different sheet?

If you can let me know these answers, I'll put something together.
Thanks,
Adam

 

[naungsai]

Dear Adam
Wow what a quick response. Thank you very much for your questiong.

1) Yes. I will open both field office file and macro file. So that both files are active.

2) I have learnt from these forum to make my macro usable all across the Excel workbooks by customing the ribbon. I have an excel file which have my collections of macro. In this particular macro file I have created new ribbon into which I have place some button. So it could run all my favrite macro in all Excel workbook. I will also put current macro into my macro master workbook.

3) The position of the "TOWN" column will not be the same. It will be changing.

Thanks again in advanced.

 

[AD_Taylor]

Give it a go like this. By the way, this is tested and worked very nicely for my test data.

1) Make sure the 'Option Compare Text' statement is copied across. This will need to be at the top of the module. Basically makes uppercase and lowecase text the same, so these are all equal: "CAT" = "cat" = "CaT"

2) Change the 2 variable assignments in the User Changeable Settings part to match your data. One is the name of the Lookup sheet and the other is the row that contains the column headings on each sheet.

Hope this helps!

Option Explicit
Option Compare Text

Sub prFindAndReplace()
    Dim tWb                 As Workbook
    Dim strLUName           As String
    Dim wsLkUp              As Worksheet
    
    Dim aWb                 As Workbook
    Dim wsTown              As Worksheet
    Dim lngRow              As Long
    Dim rngTown             As Range
    
    Dim rngFind             As Range
    Dim rngC                As Range 'Loop Counter
    Dim strReplace          As String
    
'####  User Changeable Settings ####'

    'Change the name of the sheet below to be the name of your lookup data
    strLUName = "Lookup Table"
    
    'Change the number below to be the row number that contains your column headings
    'on each TOWN sheet
    lngRow = 1
    
'#### End of Changeable Settings ####'
    
    'Set references to the 2 workbooks involved
    'tWb will be equal to the macro workbook that this code is running from
    'aWb will be equal to whatever file is shown on screen, i.e. the field office file
    Set tWb = ThisWorkbook
    Set aWb = ActiveWorkbook
    
    'Set a reference to the lookup sheet
    Set wsLkUp = tWb.Worksheets(strLUName)
    
    'Loop through every sheet in aWb // Find and replace on each sheet using original code
    For Each wsTown In aWb.Worksheets
        'See if 'TOWN' exists in the column headings row // Only Find and Replace if it does
        Set rngTown = wsTown.Range(lngRow & ":" & lngRow).Find("TOWN", LookAt:=xlWhole)
        If Not rngTown Is Nothing Then
            'Set the range to find and replace in // Should be the entire TOWN column
            Set rngTown = wsTown.Range(rngTown.Offset(1, 0), rngTown.End(xlDown))
            For Each rngC In rngTown.Cells
                strReplace = ""
                
                Set rngFind = wsLkUp.Range("A:A").Find(rngC.Value, LookAt:=xlWhole)
                If Not rngFind Is Nothing Then
                    strReplace = rngFind.Offset(0, 1).Value
                End If
                
                If strReplace <> "" Then
                    rngC.Value = strReplace
                End If
            Next rngC
        End If
    Next wsTown
End Sub

 

[naungsai]

Cheers!

You are genius.
You did it. It works in my workbook. This is the one that I need.
Also admiring your willingness to help people solve their problem.

Big big thanks.

 

[AD_Taylor]

Great! Thanks for the feedback

 

[my8950]

Great! Thanks for the feedback

I'm curious if you can help me adapt this to work on something similar I am doing?
I know this post is very old though.