Multi Find and Replace VBA Script Macro Not Working

[onb]

I am struggling with the code below - and frankly not sure if I am using the right code for my purpose. I have a file, named test.xlsm. The file has two columns, A and B. I want to run the script in other files of my choice, and hoping that will mean that any cells that have text from A, will have such text replaced with content from B. Am I doing this wrong? Thank you for your help.



Sub Multi_FindReplace()'PURPOSE: Find & Replace a list of text/values throughout entire workbook
'ORIGINAL SOURCE: www.TheSpreadsheetGuru.com/the-code-vault
'Adapted for external data




Dim sht As Worksheet
Dim fndList As Variant
Dim x As Long
Dim Source As Workbook
Dim Target As Workbook




Set Target = ThisWorkbook
Set Source = Workbooks.Open("C:\Users\NAME\Desktop\test.xlsm")




fndList = Source.Sheets(1).Range("A:B").SpecialCells(2).Value
Source.Close False




'Loop through each item in Array lists
For x = LBound(fndList) To UBound(fndList)
'Loop through each worksheet in ActiveWorkbook
For Each sht In Target.Worksheets
sht.Cells.Replace What:=fndList(x, 1), Replacement:=fndList(x, 2), _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
Next sht
Next x
End Sub

[Paul_Hossler]

Well, since you asked :yes

I'd turn it around a little

In the WB#1 with the lists, I'd have the macro below. It uses a list in the WB#1 with the From-To pairs

It opens a second WB#2 and replaces From-To pairs in WB#1 on all sheets in that WB#2

If then saves and closes WB#2

Seems to me musch easier than having the macro in many WBs and the From-To pairs in a 'database' WB





Option Explicit

'ORIGINAL SOURCE: www.TheSpreadsheetGuru.com/the-code-vault
'Adapted for external data

Sub Multi_FindReplace()
'PURPOSE: Find & Replace a list of text/values throughout entire workbook
Dim wbReplaceList As Workbook
Dim wbReplaceIn As Workbook
Dim ws As Worksheet
Dim sReplaceIn As String
Dim rReplaceList As Range
Dim iReplace As Long


'get WB name to replace in
sReplaceIn = Application.GetOpenFilename("File to Replace In, *.xls?", 1, "Select File To Replace In")
If sReplaceIn = "False" Then Exit Sub

Application.ScreenUpdating = False

Set wbReplaceIn = Workbooks.Open(sReplaceIn)
Set wbReplaceList = ThisWorkbook
Set rReplaceList = wbReplaceList.Worksheets(1).Cells(1, 1).CurrentRegion
For Each ws In wbReplaceIn.Worksheets
With rReplaceList
For iReplace = 2 To .Rows.Count
Call ws.UsedRange.Replace(.Cells(iReplace, 1).Value, .Cells(iReplace, 2).Value, xlWhole, , False)
Next iReplace
End With
Next

wbReplaceIn.Save
wbReplaceIn.Close


Application.ScreenUpdating = False
End Sub




MultiFind.xlsm has the macro and the From-To list, and ReplaceInHere.xlsx was my test WB to process

[onb]

Would it be possible not to specify the workbook where text will be replaced? Instead, having the macro work on the currently open workbook where the macro is run?

[Paul_Hossler]

Sure, but why do you want to do it that way?

You'd have to put the macro into each workbook

That macro could open the 'From-To List' WB and use that to replace

It just seems easier to have the macro and the From-To list in one WB

OR

Did you what the macro to run on all workbooks that are open?

[onb]

Basically, I download specific updates from our corporate website in excel file form, which has some private health information on it. My goal is to use this macro for replacing patient info with more private versions of it (which is stored in one file). I am curious on whether or not it is possible to download the file and run the macro so that you instantly have a file that is edited to my specifications. Is there a way to isolate the macro action to the file that I just downloaded and opened without editing the code every time?

[onb]

Actually, I was using your version wrong. Now I figured it out. This is wonderful, thank you very much!

[onb]

Small follow-up: is it possible for the macro to detect a portion of the text within a cell, and replace only such a portion. I noticed that the macro only works when the whole cell is the text that I am trying to find and replace.

Thank you for all of your help.

[Paul_Hossler]

In this line, replace xlWhole with xlPart and you should be OK





Call ws.UsedRange.Replace(.Cells(iReplace, 1).Value, .Cells(iReplace, 2).Value, xlWhole, , False)

[onb]

That last tip worked perfectly as well, thank you!

Last question (I hope): Is there a way to make sure that the updated cells are adjusted in row height appropriately? Because some additional info is added to the cells, the text does not fit entirely in to the cells, requiring an additional step of resizing the rows. Curious to see if there is anything more automated that could be added to the macro.

[Paul_Hossler]

Is this what you meant?




Option Explicit
'ORIGINAL SOURCE: www.TheSpreadsheetGuru.com/the-code-vault
'Adapted for external data
Sub Multi_FindReplace() 'PURPOSE: Find & Replace a list of text/values throughout entire workbook
Dim wbReplaceList As Workbook
Dim wbReplaceIn As Workbook
Dim ws As Worksheet
Dim sReplaceIn As String
Dim rReplaceList As Range
Dim iReplace As Long


'get WB name to replace in
sReplaceIn = Application.GetOpenFilename("File to Replace In, *.xls?", 1, "Select File To Replace In")
If sReplaceIn = "False" Then Exit Sub

Application.ScreenUpdating = False

Set wbReplaceIn = Workbooks.Open(sReplaceIn)
Set wbReplaceList = ThisWorkbook
Set rReplaceList = wbReplaceList.Worksheets(1).Cells(1, 1).CurrentRegion
For Each ws In wbReplaceIn.Worksheets
With rReplaceList
For iReplace = 2 To .Rows.Count
Call ws.UsedRange.Replace(.Cells(iReplace, 1).Value, .Cells(iReplace, 2).Value, xlPart, , False)
Next iReplace

ws.Rows.AutoFit ' added

End With
Next

wbReplaceIn.Save
wbReplaceIn.Close


Application.ScreenUpdating = False
End Sub

[onb]

One more last question (I think this is it, last question, sorry!). After the last code does its thing, is it possible to have one more code that searches cells in the workbook and deletes text "HHA", "CNA", and "HHAV"? Basically, deletes only that specific text but leaves everything else alone. Thank you very much for your help in advance.

[Paul_Hossler]

Should just require the 3 new lines below



Option Explicit
'ORIGINAL SOURCE: www.TheSpreadsheetGuru.com/the-code-vault
'Adapted for external data
Sub Multi_FindReplace() 'PURPOSE: Find & Replace a list of text/values throughout entire workbook
Dim wbReplaceList As Workbook
Dim wbReplaceIn As Workbook
Dim ws As Worksheet
Dim sReplaceIn As String
Dim rReplaceList As Range
Dim iReplace As Long


'get WB name to replace in
sReplaceIn = Application.GetOpenFilename("File to Replace In, *.xls?", 1, "Select File To Replace In")
If sReplaceIn = "False" Then Exit Sub

Application.ScreenUpdating = False

Set wbReplaceIn = Workbooks.Open(sReplaceIn)
Set wbReplaceList = ThisWorkbook
Set rReplaceList = wbReplaceList.Worksheets(1).Cells(1, 1).CurrentRegion
For Each ws In wbReplaceIn.Worksheets
With rReplaceList
For iReplace = 2 To .Rows.Count
Call ws.UsedRange.Replace(.Cells(iReplace, 1).Value, .Cells(iReplace, 2).Value, xlPart, , False)
Next iReplace

'HHAV has to be before HHA
Call ws.UsedRange.Replace("HHAV", vbNullString, xlPart, , False)
Call ws.UsedRange.Replace("HHA", vbNullString, xlPart, , False)
Call ws.UsedRange.Replace("CNA", vbNullString, xlPart, , False)

ws.Rows.AutoFit ' added

End With
Next

wbReplaceIn.Save
wbReplaceIn.Close


Application.ScreenUpdating = False
End Sub

[onb]

That works perfectly! Exactly what I needed, thank you.

One thing I noticed is that the auto row fit code seems to adjust to the first cells in line from the left, and not so much to the cell with the most text in the row. Is there a way to fix this? Not a major issue, but thought I'd check if there is a way around it.

[Paul_Hossler]

replace that line with these and see if it helps




ws.Rows.RowHeight = 100
ws.Rows.EntireRow.AutoFit

[onb]

At this time, based on your instructions, my code is as follows;


Option Explicit'ORIGINAL SOURCE: www.TheSpreadsheetGuru.com/the-code-vault
'Adapted for external data
Sub Multi_FindReplace() 'PURPOSE: Find & Replace a list of text/values throughout entire workbook
Dim wbReplaceList As Workbook
Dim wbReplaceIn As Workbook
Dim ws As Worksheet
Dim sReplaceIn As String
Dim rReplaceList As Range
Dim iReplace As Long


'get WB name to replace in
sReplaceIn = Application.GetOpenFilename("File to Replace In, *.xls?", 1, "Select File To Replace In")
If sReplaceIn = "False" Then Exit Sub

Application.ScreenUpdating = False

Set wbReplaceIn = Workbooks.Open(sReplaceIn)
Set wbReplaceList = ThisWorkbook
Set rReplaceList = wbReplaceList.Worksheets(1).Cells(1, 1).CurrentRegion
For Each ws In wbReplaceIn.Worksheets
With rReplaceList
For iReplace = 2 To .Rows.Count
Call ws.UsedRange.Replace(.Cells(iReplace, 1).Value, .Cells(iReplace, 2).Value, xlPart, , False)
Next iReplace

'HHAV has to be before HHA
Call ws.UsedRange.Replace("HHAV", vbNullString, xlPart, , False)
Call ws.UsedRange.Replace("HHA", vbNullString, xlPart, , False)

ws.Rows.EntireRow.AutoFit

End With
Next

wbReplaceIn.Save


Application.ScreenUpdating = False
End Sub




24713

I attached a file "Schedule.xlsx" - basically, the file where stuff gets replaced by the aforementioned code. To further streamline our workflow, is it possible to simplify the data in the schedule, as in using the data in the calendar to create a list like so;

July 31st
Data from boxes under it
Data from boxes under it
Data from boxes under it
Data from boxes under it

August 1st
Data from boxes under it
Data from boxes under it
Data from boxes under it
Data from boxes under it

All in one column, either in excel, or somehow transitioned to another text document such as Word. The only thing is, when the file (Schedule file) is downloaded, the number of cells under a date varies, depending on how many entries were made.

[onb]

bump

[Paul_Hossler]

Possilby do-able, but all the merged cells, hidden (or small) rows and columns make it very hard to just get the data

Could you simplify the format, and only use merged cells in non-event areas?

24769