Replace 1 word without opening Files

[Guest]

Hello from Steve Dee

Is it possible please to replace Stagecoach with NZ Bus without having to
open each file. ( Over 650 off them to do )

Thankyou.

 

[JW]

More info needed! Replace them "in" the workbook? Which Sheet?
Replace them in the filename itself?

 

[Ron de Bruin]

Hi Steved

You can look here
http://www.erlandsendata.no/english/index.php?t=envbadac

OR

Try this macro
http://www.rondebruin.nl/copy4.htm

The first example

 

[Guest]

Hello JW

Replace them in the filename itself "No"

Replace them "in" the workbook? "Yes Please" Which Sheet " Every Sheet"

Thankyou.

 

[Guest]

Hello Ron From Steved

Ron My objective is to find Stagecoach in Line 1 and replace with NZ Bus

What the below has done to all my Files is A1:AZ1 in each cell in the below
Range it put NZ Bus for example A1, B1 all through to AZ1.

Please How Can I tell The Below Range To Find Stagecoach and Replace with NZ
Bus as it could be anywhere on Row 1 for example Q1 or T1 or W1 or AZ1
Thankyou.

..Range("A1:AZ1").Value = "NZ Bus"

 

[Ron de Bruin]

Hi Steve

Test this one that use Replace in the first row of the first sheet

Sub Example()
Dim MyPath As String, FilesInPath As String
Dim MyFiles() As String, Fnum As Long
Dim mybook As Workbook
Dim CalcMode As Long
Dim sh As Worksheet
Dim ErrorYes As Boolean

'Fill in the path\folder where the files are
MyPath = "C:\Users\Ron\test"

'Add a slash at the end if the user forget it
If Right(MyPath, 1) <> "\" Then
MyPath = MyPath & "\"
End If

'If there are no Excel files in the folder exit the sub
FilesInPath = Dir(MyPath & "*.xl*")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If

'Fill the array(myFiles)with the list of Excel files in the folder
Fnum = 0
Do While FilesInPath <> ""
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = FilesInPath
FilesInPath = Dir()
Loop

'Change ScreenUpdating, Calculation and EnableEvents
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With

'Loop through all files in the array(myFiles)
If Fnum > 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Nothing
On Error Resume Next
Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))
On Error GoTo 0

If Not mybook Is Nothing Then


'Change cell value(s) in one worksheet in mybook
On Error Resume Next
With mybook.Worksheets(1)
If .ProtectContents = False Then
.Rows("1:1").Replace What:="Stagecoach", Replacement:="NZ Bus", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Else
ErrorYes = True
End If
End With


If Err.Number > 0 Then
ErrorYes = True
Err.Clear
'Close mybook without saving
mybook.Close savechanges:=False
Else
'Save and close mybook
mybook.Close savechanges:=True
End If
On Error GoTo 0
Else
'Not possible to open the workbook
ErrorYes = True
End If

Next Fnum
End If

If ErrorYes = True Then
MsgBox "There are problems in one or more files, possible problem:" _
& vbNewLine & "protected workbook/sheet or a sheet/range that not exist"
End If

'Restore ScreenUpdating, Calculation and EnableEvents
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With
End Sub

 

[Guest]

Thankyou Very Much Ron

Hi Steve

Test this one that use Replace in the first row of the first sheet

Sub Example()
Dim MyPath As String, FilesInPath As String
Dim MyFiles() As String, Fnum As Long
Dim mybook As Workbook
Dim CalcMode As Long
Dim sh As Worksheet
Dim ErrorYes As Boolean

'Fill in the path\folder where the files are
MyPath = "C:\Users\Ron\test"

'Add a slash at the end if the user forget it
If Right(MyPath, 1) <> "\" Then
MyPath = MyPath & "\"
End If

'If there are no Excel files in the folder exit the sub
FilesInPath = Dir(MyPath & "*.xl*")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If

'Fill the array(myFiles)with the list of Excel files in the folder
Fnum = 0
Do While FilesInPath <> ""
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = FilesInPath
FilesInPath = Dir()
Loop

'Change ScreenUpdating, Calculation and EnableEvents
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With

'Loop through all files in the array(myFiles)
If Fnum > 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Nothing
On Error Resume Next
Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))
On Error GoTo 0

If Not mybook Is Nothing Then


'Change cell value(s) in one worksheet in mybook
On Error Resume Next
With mybook.Worksheets(1)
If .ProtectContents = False Then
.Rows("1:1").Replace What:="Stagecoach", Replacement:="NZ Bus", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Else
ErrorYes = True
End If
End With


If Err.Number > 0 Then
ErrorYes = True
Err.Clear
'Close mybook without saving
mybook.Close savechanges:=False
Else
'Save and close mybook
mybook.Close savechanges:=True
End If
On Error GoTo 0
Else
'Not possible to open the workbook
ErrorYes = True
End If

Next Fnum
End If

If ErrorYes = True Then
MsgBox "There are problems in one or more files, possible problem:" _
& vbNewLine & "protected workbook/sheet or a sheet/range that not exist"
End If

'Restore ScreenUpdating, Calculation and EnableEvents
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With
End Sub