Macros/VBA Code for repetitive 'find and replace'

bu5tarf

New Member
Joined
May 14, 2011
Messages
18
Hi,

Does anyone know the VBA code for a macro in excel to record the motion of finding and then substituting values from individual cells from one column for the individual cells in another column?

For example:

Cells A2 to A48 in workbook1 contains a list of many different values (Peugeot, Alfa Romeo, Ford, Renault etc...) and in cells B2 to B48 are their corresponding decimal values that need to replace them in another workbook (workbook2).

In Column A of workbook2 has thousands of instances of the values present in A2 to A48 of workbook1. The numeric values from B2 to B48 (lets say ford = 0.1 and peugeot = -0.4) need to replace the original text data in column A of workbook 2. (so 0.1 replaces ford and -0.4 replaces peugeot)

I've tried using macros but it will only run the exact steps it recorded and not move down the cells even when using relative references.

Because there are 2000 rows of data, using copy (from A2) and paste (into find from find and replace), and then copy( from B2) and paste into replace (from find and replace) is proving very tedious and time consuming as there are 24 columns to do this for (not forgetting the 2000 rows!).

Please Help!!!

Thanks :)
 

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes
This may help. You need to build on it

For Each a In [A2:A200] '/////////////////
a.Cells.Select
If a.Cells.Value = "ford" Then a.Cells.Value = ".1"


Next '/////////////////////////////////////
 
Upvote 0
Code:
Sub Replace_List()

    Dim rList As Range, cell As Range

    If ActiveWorkbook.Name = ThisWorkbook.Name Then
        MsgBox "1st select the workbook and worksheet with the data you want to replace." & vbLf & _
        "Then run this macro again.", vbExclamation, "Select the Data Worksheet"
        Exit Sub
    End If
    
    Application.ScreenUpdating = False
        
    With ThisWorkbook.Sheets(1)
        Set rList = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
    End With
    
    For Each cell In rList
        ActiveSheet.Cells.Replace What:=cell.Value, _
                                  Replacement:=cell.Offset(0, 1).Value, _
                                  LookAt:=xlPart, _
                                  MatchCase:=False
                                  
    Next cell
    
    Application.ScreenUpdating = True
    
    MsgBox "Replaced all items from the list.", vbInformation, "Replacements Complete"
    
End Sub
 
Last edited:
Upvote 0
Why not use VLOOKUP in a spare column on Sheet2 to get the values and them copy/paste special values over the original text values?

That could all be end in code of course.
 
Upvote 0
Code:
Sub Replace_List()

    Dim rList As Range, cell As Range

    If ActiveWorkbook.Name = ThisWorkbook.Name Then
        MsgBox "1st select the workbook and worksheet with the data you want to replace." & vbLf & _
        "Then run this macro again.", vbExclamation, "Select the Data Worksheet"
        Exit Sub
    End If
    
    Application.ScreenUpdating = False
        
    With ThisWorkbook.Sheets(1)
        Set rList = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
    End With
    
    For Each cell In rList
        ActiveSheet.Cells.Replace What:=cell.Value, _
                                  Replacement:=cell.Offset(0, 1).Value, _
                                  LookAt:=xlPart, _
                                  MatchCase:=False
                                  
    Next cell
    
    Application.ScreenUpdating = True
    
    MsgBox "Replaced all items from the list.", vbInformation, "Replacements Complete"
    
End Sub

Thank you for your response, it is very much appreciated. When I tested this, it just replaced all the cells with random decimal numbers :-S
 
Upvote 0
Thanks for your responses so far.

Vlookup would be just as tedious because there are 20 + columns in the original speadsheet and 2000 records. one of the columns has over 1000 different discrete/nominal items in it with more than one occurrence of each instance.

Escott - thank you but trying to avoid hard coding the attributes instance names because it would prove extremely tedious :(
 
Upvote 0
Like i said the whole thing could be done with code, in fact for what you originally mentioned it would take about 5-6 lines of code.

Obviously with the expanded set-up you now mention it would mean a few more.

I actually tried posting code based on your original post but for some reason it didn't post.

Didn't save it either.:oops:

PS VLOOKUP would work with that amount of data easily, and repeats wouldn't matter.
 
Upvote 0
Thanks Norie, really appreciate it.

Will have a try and play around with it. I'm a VBA Novice so its very tricky stuff to me and its very very important that this data is accurately and efficiently replaced by the correct values :(

Would it be possible to send me some sample code via email or private message on here?
 
Upvote 0
The Replace_List macro code goes in the workbook that has the replacement list.

The replacement list is assumed to be on the 1st sheet in that workbook in columns A and B
Code:
    With ThisWorkbook.Sheets(1)
        Set rList = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
    End With

The code isn't replacing with random decimal numbers.

Try changing...
Code:
                                  LookAt:=xlPart, _
To
Code:
                                  LookAt:=xlWhole, _

This will look for an exact match instead of a partial match. I didn't realize you were searching for numbers.
 
Upvote 0
Hi,

Try
Code:
Sub somecode()
Dim d As Object, e As Range
Set d = CreateObject("scripting.dictionary")
For Each e In Sheets("sheet1").Range("A2:A48")
    d(e.Value) = e.Offset(, 1).Value
Next
With Sheets("sheet2").Range("A:A")
For Each e In Range(.Cells(2), .Cells(Rows.Count).End(3))
    e.Value = d(e.Value)
Next
End With
End Sub
 
Upvote 0

Forum statistics

Threads
1,214,812
Messages
6,121,696
Members
449,048
Latest member
81jamesacct

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top