Change text in a macro with another macro

jjpkraft

New Member
Joined
Feb 26, 2002
Messages
32
I have a excel template that won't open unless the file "Commercial Menu.xls" is open.

Code:
On Error GoTo MenuNotOpenError 
Workbooks("Commercial Menu.xls").Activate 
Workbooks(ChecklistWorkbookName).Activate 

MenuNotOpenError: 
    Select Case Err 
        Case 9 
            MsgBox prompt:="Commercial UW Menu must be open." 
        Case Else 
        End Select 
    Workbooks(ChecklistWorkbookName).Activate 
    ActiveWorkbook.Close SaveChanges:=False 
    Exit Sub

The problem is I had to change the file that needs to be open from "Commercial Menu.xls" to "UW Menu.xls". I've corrected the code so new files using the template open as long as "UW Menu.xls" is open but old files won't open since "Commercial Menu.xls" no longer exists.

Is there a way to open all the workbooks in a folder (one at a time) and replace all occurences of "Commercial" with "UW" in the code?

This one has me stumped.

Jason
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
I am pretty sure questions like this have come up in the past, though I am having a hard time locating them using the Search functionality (a search on keywords UPDATE and MACRO returns many hits).

For future reference, it is wise to store a hard coded value either in a global variable in the VB code, or in a cell somewhere on the worksheet and then reference the variable/cell in your code. If you store it in a cell on the worksheet, writing a macro to find it and update it would be very easy.
 
Upvote 0
The find..replace in the VB editor works fine for each file but there are over 500 workbooks.

I need to run a macro that opens the workbooks one at a time and changes the text in the code automatically.
 
Upvote 0
Hello Jason,

Try the following code as something to get you started. If you need some additional help to spin through multiple files feel free to post again. The components include Standard Modules, Class Modules, UserForm code, Worksheet code, etc. One of the interesting things about the code is that it also checks the immediate window as a ThisWorkBook component.

To test this, create a new workbook and insert some modules, classes and userforms into the project. Then add some common stuff like Module1_TestIt1, Module2_TestIt1, Module2_TestIt2, ThisWorkBook_TestIt1, etc. Then call the module below like this in the immediate window:

Call ModuleFindAndReplace("TestIt", "TestIt")

That way it will report all the "changes" for you to verify that the code works. As noted above, the best way would be to have your hard coded file name defined in a global constant so you would only have to change it once.

Enjoy and Good Luck!

PS. You will not be able to single step through the entire code because of the .Replace statement. If you want to watch it work you will need to comment out the .Replace statement until you are ready to run it realtime.

Option Explicit

'From vbext_ComponentType enumeration
Private Const vbext_ct_ActiveXDesigner = 11
Private Const vbext_ct_ClassModule = 2
Private Const vbext_ct_Document = 100 '(&H64)
Private Const vbext_ct_MSForm = 3
Private Const vbext_ct_StdModule = 1

Public Function ModuleFindAndReplace(FindText As String, _
ReplaceText As String, _
Optional DeclarationsText As String) As Boolean
Dim objComponent As Object
Dim strTemp As String
Dim lngStartRow As Long, lngStartCol As Long, lngEndRow As Long, lngEndCol As Long
With Application.VBE.ActiveVBProject
For Each objComponent In .VBComponents
With objComponent.CodeModule
If .CountOfLines > 0 Then
lngStartRow = 1: lngStartCol = 1
'Setting to -1 signifies last row and column
lngEndRow = -1: lngEndCol = -1
Do While .Find(FindText, lngStartRow, lngStartCol, -lngEndRow, -lngEndCol, False, False)
If objComponent.Type <> vbext_ct_Document Then
MsgBox "Found " & FindText & " at " & lngStartRow & " " & lngStartCol & " " & lngEndRow & " " & lngEndCol
strTemp = .Lines(lngStartRow, 1)
strTemp = Replace$(strTemp, FindText, ReplaceText)
Debug.Print objComponent.Name & " " & objComponent.Type & " start: " & lngStartRow & "," & lngStartCol & " End: " & lngEndRow & "," & lngEndCol & vbCrLf & _
" Before: " & .Lines(lngStartRow, 1) & vbCrLf & " After: " & strTemp
.ReplaceLine lngStartRow, strTemp
End If
lngStartRow = lngStartRow + 1: lngStartCol = lngStartCol + 1
Loop
End If
End With
Next objComponent
End With
Set objComponent = Nothing
End Function
 
Upvote 0
It's not replacing the text "commercial" with "UW" in the code. I don't understand why. Help.

Code:
Option Explicit

'From vbext_ComponentType enumeration
Private Const vbext_ct_ActiveXDesigner = 11
Private Const vbext_ct_ClassModule = 2
Private Const vbext_ct_Document = 100 '(&H64)
Private Const vbext_ct_MSForm = 3
Private Const vbext_ct_StdModule = 1

Private Sub FindAndReplace()
    Dim i As Integer 'counter of files
    Dim GarageFile As String
    Dim FDir As String
    
    GarageFile = "*"
    FDir = "C:\Garage TEST\"
    With Application.FileSearch
        .NewSearch
        .LookIn = FDir
        .SearchSubFolders = False
        .Filename = GarageFile
        .FileType = msoFileTypeAllFiles
        .Execute
    End With
    For i = 1 To 2
        Workbooks.Open Filename:=Application.FileSearch.FoundFiles(i)
        Call ModuleFindAndReplace("Commercial", "UW")
        Call ModuleFindAndReplace("Home", "Main")
        ActiveWorkbook.Close SaveChanges:=True
    Next i 
End Sub

Public Function ModuleFindAndReplace(FindText As String, ReplaceText As String, Optional DeclarationsText As String) As Boolean
    Dim objComponent As Object
    Dim strTemp As String
    Dim lngStartRow As Long, lngStartCol As Long, lngEndRow As Long, lngEndCol As Long
    Dim i As Integer
    With Application.VBE.ActiveVBProject
        For Each objComponent In .VBComponents
        With objComponent.CodeModule
            If .CountOfLines > 0 Then
                lngStartRow = 1: lngStartCol = 1
                'Setting to -1 signifies last row and column
                lngEndRow = -1: lngEndCol = -1
                Do While .Find(FindText, lngStartRow, lngStartCol, -lngEndRow, -lngEndCol, False, False)
                    If objComponent.Type <> vbext_ct_Document Then
                        MsgBox "Found " & FindText & " at " & lngStartRow & " " & lngStartCol & " " & lngEndRow & " " & lngEndCol
                        strTemp = .Lines(lngStartRow, 1)
                        strTemp = Replace(strTemp, FindText, ReplaceText)
                        Debug.Print objComponent.Name & " " & objComponent.Type & " start: " & lngStartRow & "," & lngStartCol & " End: " & lngEndRow & "," & lngEndCol & vbCrLf & " Before: " & .Lines(lngStartRow, 1) & vbCrLf & " After: " & strTemp
                        .ReplaceLine lngStartRow, strTemp
                    End If
                    lngStartRow = lngStartRow + 1
                    lngStartCol = lngStartCol + 1
                Loop
            End If
        End With
        Next objComponent
    End With
    Set objComponent = Nothing
End Function
 
Upvote 0
Hello Jason,

From your question, do I infer that it is working correctly for the other search and replace? In reviewing my code, I'm not sure why I had this line:

lngStartRow = lngStartRow + 1: lngStartCol = lngStartCol + 1

Try replacing it with this line and see if it helps:

lngStartRow = lngStartRow + 1: lngStartCol = 1

Good Luck!
 
Upvote 0
Thanks sbendbuckeye. It's close but not quite right.

I added that change along with a few others and it almost works. It changes the code in the modules but not in ThisWorkbook...I need to change something in the Workbook_Open event.

Does it have something to do with the CodeModule???
 
Upvote 0
Hello Jason,

I'm not sure and I'm not at a place where I can check, but I think they are considered documents. Comment out this conditional statement and see if it works:

If objComponent.Type <> vbext_ct_Document Then

Good Luck!
 
Upvote 0

Forum statistics

Threads
1,224,891
Messages
6,181,614
Members
453,057
Latest member
LE102024

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