VBA Find and Replace using another workbook

decadence

Well-known Member
Joined
Oct 9, 2015
Messages
524
Office Version
  1. 365
  2. 2016
  3. 2013
  4. 2010
  5. 2007
Platform
  1. Windows
Hi, I am trying to do a find and replace part of a string in the selected cell values in Book1-Sheet1 using Book2-Sheet1. Book 2 contains what to search for in a column 1 and the replacement is in the adjacent column. The Find and Replace Values is a long list of over more than 10,000 Rows
Can someone help with this please.

Code Below of what I have so far....

Code:
Public Const DesPath As String = "C:\Users\decadence\Lookup Sheets\Replace Data.xlsx"
Public Const DesName As String = "Replace Data.xlsx"
Dim xVal1 as Range, Rng as Range, xVal2 as Range, Rng2 as Range, Fnd as Range
Dim Findtext As String, Replacetext As String
Dim wb1 As Workbook, ws1 As Worksheet, wb2 As Workbook, ws2 As Worksheet

Sub Test()

    Set wb1 = ActiveWorkbook
    Set ws1 = wb1.ActiveSheet
    Set Rng = MyRng
    Workbooks.Open Filename:=DesPath
    Set wb2 = Workbooks(DesName)
    Set ws2 = wb2.Sheets("Replace")
        If SheetExist("Replace") Then
            ws2.Activate
            Set Rng2 = RngDes
            'ActiveWindow.Visible = False
            For Each xVal1 In Rng
                For Each xVal2 In Rng2
                    Findtext = xVal2.Value
                    Replacetext = xVal2.Offset(, 1).Value
                        If xVal1.Value = Findtext Then xVal1.Value = Replacetext
                    Next xVal2
            Next xVal1
         End If
    'Workbooks(DesName).Close False
End Sub

Function MyRng() As Range
    Set MyRng = Intersect(ActiveWindow.Selection, ActiveSheet.UsedRange)
End Function

Function SheetExist(strSheetName As String) As Boolean
    For k = 1 To Worksheets.Count
        If Worksheets(k).Name = strSheetName Then
            SheetExist = True
            Exit Function
        End If
    Next k
End Function

Function RngDes() As Range
    Set Fnd = ActiveSheet.Columns.Find(What:="Find Values", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)
        If Not Fnd Is Nothing Then
            Set RngDes = Range(Fnd.Offset(1), Cells(Rows.Count, Fnd.Column).End(xlUp))
        End If
End Function

From This
Book1 Sheet1
App is here
This App is void
Not an App

<tbody>
</tbody>

To This
Book1 Sheet1
Apple is here
This Apple is void
Not an Apple

<tbody>
</tbody>

Using This
Book2 Sheet1
Find Values
Replace Values
App
Apple
Ban
Banana

<tbody>
</tbody>
 
Last edited:

Some videos you may like

Excel Facts

What is =ROMAN(40) in Excel?
The Roman numeral for 40 is XL. Bill "MrExcel" Jelen's 40th book was called MrExcel XL.

Akuini

Well-known Member
Joined
Feb 1, 2016
Messages
2,936
Office Version
  1. 365
Platform
  1. Windows
Hi, I am trying to do a find and replace part of a string in the selected cell values in Book1-Sheet1 using Book2-Sheet1. Book 2 contains what to search for in a column 1 and the replacement is in the adjacent column. The Find and Replace Values is a long list of over more than 10,000 Rows

That's a long list indeed. The speed will be an issue here.
And how many rows of data do you have in Book1-Sheet1?

Have you consider a problem:
for example: App to Apple
finding a word as part of a cell (not as a whole) means that if you already have apple or application etc (in Book1-Sheet1), then it will be replaced too, so you will get applele, applelication.
I don't know the real data, do you think it won't be a situation like that?
 

decadence

Well-known Member
Joined
Oct 9, 2015
Messages
524
Office Version
  1. 365
  2. 2016
  3. 2013
  4. 2010
  5. 2007
Platform
  1. Windows
Hi Akuini, I have managed to sort this now, thanks for your reply

From This

Code:
Findtext = xVal2.Value
Replacetext = xVal2.Offset(, 1).Value
If xVal1.Value = Findtext Then xVal1.Value = Replacetext

To This

Code:
MyText = xVal1.Text
Findtext = xVal2.Text
Replacetext = xVal2.Offset(, 1).Text
If InStr(1, MyText, xVal2) Then xVal1 = Replace(MyText, Findtext, Replacetext)
 

Akuini

Well-known Member
Joined
Feb 1, 2016
Messages
2,936
Office Version
  1. 365
Platform
  1. Windows
Ok, glad you figured it out.
 

Watch MrExcel Video

Forum statistics

Threads
1,122,254
Messages
5,595,097
Members
413,969
Latest member
rashmikant

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
Top