Hello guys,



I have 14 files (every of them with several tabs) where there are several
replacements to do.

55 old values need to be replaced with 12 new strings, f. ex:



old value_ to be replaced with new value_

apple 1 orange1

apple 2 orange1

apple 32 orange1

apple 8 orange22

pineapple21 orange22

pineapple5 orange22

pineapple3 orange22

pineapple43 orange22

grape1 orange444

grape122 orange444

.. .



Could you help me to write a macro that will :

1) treat all the files/tabs in the specified folder (f. ex. C:\test) -
I'll put there all the files that I want to change

2) make changes to them (all files, all tabs) based on the open file
"replacement_template.xls" (where I have column A (old values) and B (new
values))

3) highlight (in yellow) all the changed cells and put in comments to
the every changed cell the old value



Seems at the same time easy and complex to do.

In advance many thanks for any hints/draft solutions you could provide!

Regards,

Mark

Try this:

Sub AdvancedReplaceMacro()
folderspec = "c:\test"
Dim fs, f, f1, fc
Dim strReplacementText As String
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderspec)
Set fc = f.Files
For Each f1 In fc 'runs through all files
Workbooks.Open f1
For intCount = 1 To Workbooks(f1.Name).Worksheets.Count 'runs
through all sheets
Workbooks(f1.Name).Worksheets(intCount).Select
Cells(1, 1).Select 'selects cell A1 - you may need to
change this
Do
Select Case ActiveCell.Value 'changes values
Case "apple 1", "apple 2", "apple 32"
strReplacementText = "orange1"
Case "apple 8", "pineapple21", "pineapple5",
"pineapple3", "pineapple43"
strReplacementText = "orange22"
Case Else
MsgBox "Cannot find '" & ActiveCell.Value & "'.",
vbInformation
strReplacementText = ""
End Select
If strReplacementText < "" Then Call
UpdateValue(strReplacementText)

strReplacementText = ""
ActiveCell.Offset(1, 0).Select
Loop Until ActiveCell.Row =
Cells.SpecialCells(xlCellTypeLastCell).Row 'loop until end
Next intCount
Next
End Sub
Function UpdateValue(strReplacementText As String)
'updates colour and comment
Selection.Interior.ColorIndex = 36
Range(ActiveCell.Address).AddComment
Range(ActiveCell.Address).Comment.Visible = False
Range(ActiveCell.Address).Comment.Text Text:="Old Value:" & Chr(10)
& ActiveCell.Value
Range(ActiveCell.Address).Value = strReplacementText
End Function


markx wrote:
Hello guys,



I have 14 files (every of them with several tabs) where there are several
replacements to do.

55 old values need to be replaced with 12 new strings, f. ex:



old value_ to be replaced with new value_

apple 1 orange1

apple 2 orange1

apple 32 orange1

apple 8 orange22

pineapple21 orange22

pineapple5 orange22

pineapple3 orange22

pineapple43 orange22

grape1 orange444

grape122 orange444

. .



Could you help me to write a macro that will :

1) treat all the files/tabs in the specified folder (f. ex. C:\test) -
I'll put there all the files that I want to change

2) make changes to them (all files, all tabs) based on the open file
"replacement_template.xls" (where I have column A (old values) and B (new
values))

3) highlight (in yellow) all the changed cells and put in comments to
the every changed cell the old value



Seems at the same time easy and complex to do.

In advance many thanks for any hints/draft solutions you could provide!

Regards,

Mark

Thanks a lot, FunkySquid!
It's excellent!!!

i was just wondering if you (or somebody else) know how to modify this code
in two points:
1) Close every workbook once it's changed
2) the cells to replace can be anywhere on the sheet (and not only in one
specific column, like "A" in your exemple) <I was probably not very clear on
this one in my e-mail, sorry about this

Once again, a big thank to you,
Cheers,
Mark

"FunkySquid" wrote in message
oups.com...
Try this:

Sub AdvancedReplaceMacro()
folderspec = "c:\test"
Dim fs, f, f1, fc
Dim strReplacementText As String
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderspec)
Set fc = f.Files
For Each f1 In fc 'runs through all files
Workbooks.Open f1
For intCount = 1 To Workbooks(f1.Name).Worksheets.Count 'runs
through all sheets
Workbooks(f1.Name).Worksheets(intCount).Select
Cells(1, 1).Select 'selects cell A1 - you may need to
change this
Do
Select Case ActiveCell.Value 'changes values
Case "apple 1", "apple 2", "apple 32"
strReplacementText = "orange1"
Case "apple 8", "pineapple21", "pineapple5",
"pineapple3", "pineapple43"
strReplacementText = "orange22"
Case Else
MsgBox "Cannot find '" & ActiveCell.Value & "'.",
vbInformation
strReplacementText = ""
End Select
If strReplacementText < "" Then Call
UpdateValue(strReplacementText)

strReplacementText = ""
ActiveCell.Offset(1, 0).Select
Loop Until ActiveCell.Row =
Cells.SpecialCells(xlCellTypeLastCell).Row 'loop until end
Next intCount
Next
End Sub
Function UpdateValue(strReplacementText As String)
'updates colour and comment
Selection.Interior.ColorIndex = 36
Range(ActiveCell.Address).AddComment
Range(ActiveCell.Address).Comment.Visible = False
Range(ActiveCell.Address).Comment.Text Text:="Old Value:" & Chr(10)
& ActiveCell.Value
Range(ActiveCell.Address).Value = strReplacementText
End Function


markx wrote:
Hello guys,



I have 14 files (every of them with several tabs) where there are several
replacements to do.

55 old values need to be replaced with 12 new strings, f. ex:



old value_ to be replaced with new value_

apple 1 orange1

apple 2 orange1

apple 32 orange1

apple 8 orange22

pineapple21 orange22

pineapple5 orange22

pineapple3 orange22

pineapple43 orange22

grape1 orange444

grape122 orange444

. .



Could you help me to write a macro that will :

1) treat all the files/tabs in the specified folder (f. ex.
C:\test) -
I'll put there all the files that I want to change

2) make changes to them (all files, all tabs) based on the open
file
"replacement_template.xls" (where I have column A (old values) and B (new
values))

3) highlight (in yellow) all the changed cells and put in comments
to
the every changed cell the old value



Seems at the same time easy and complex to do.

In advance many thanks for any hints/draft solutions you could provide!

Regards,

Mark

If you have more than a handful of replacement values, you may instead want
to creat a lookup table, then have the macro reference that. That would
eliminate your need for a "case" for every set of values.


"markx" wrote:

Hello guys,



I have 14 files (every of them with several tabs) where there are several
replacements to do.

55 old values need to be replaced with 12 new strings, f. ex:



old value_ to be replaced with new value_

apple 1 orange1

apple 2 orange1

apple 32 orange1

apple 8 orange22

pineapple21 orange22

pineapple5 orange22

pineapple3 orange22

pineapple43 orange22

grape1 orange444

grape122 orange444

.. .



Could you help me to write a macro that will :

1) treat all the files/tabs in the specified folder (f. ex. C:\test) -
I'll put there all the files that I want to change

2) make changes to them (all files, all tabs) based on the open file
"replacement_template.xls" (where I have column A (old values) and B (new
values))

3) highlight (in yellow) all the changed cells and put in comments to
the every changed cell the old value



Seems at the same time easy and complex to do.

In advance many thanks for any hints/draft solutions you could provide!

Regards,

Mark

Thanks for the FINE explanation; it is of great help.
3 of the 4 (undeclared) I see are declared using "SET",
but the f1 - NOT - Since it is being followed by the Key Word(s) "For Each"
I take it to mean that it must automatically cover "things..." (not
requiring it to be done explicitly.?).


"FunkySquid" wrote:

The variables (fs, f, f1, fc) are not given a data type like string,
Integer etc so Excel makes them variants (which allows it to hold any
data type).

It is the code:

Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderspec)
Set fc = f.Files

that sets each variable. f1 is assigned in the code:

For Each f1 In fc

basically it is saying for each 'file' (f1) out of all the 'files' (fc)
in the give 'folder' (f)

It might be easier to change the variable names to more meaningful
names like:

dim myFileSystem, myFolder, myFileCollection, myFile

then

For Each myFile In myFileCollection

It might be worth you just going through the code line by line by
pressing the F8 key and looking at what Excel does to the variables.
Goto View / Locals to be able to view the variables.

FunkySquid

Jim May wrote:
FunkySquid;
This code is awesome - I'de like to work my way through it;
First SIMPLETON Question (I should know, but I'm still too new this
this)..
The Variable f1 (I see it declared (are all fs, f, f1, fc 'As Range?))
How Does it (f1) get assigned? Is it being aster the keywords For Each
That gives it "extra meaning"?
Thanks,


"FunkySquid" wrote in message
oups.com:

Hi there, try this code. I've changed it so that it doesn't do a case
lookup anymore, it does a find instead. I've also updated the code to
close and save the workbooks.

Dim strOldText As String
Dim strNewText As String
Const strReplacementFileName As String = "replacement_template.xls"
Const strReplacementFile As String = "c:\test\"
Const folderspec As String = "c:\test"
Dim boolCannotFindAnymore As Boolean
Sub AdvancedReplaceMacro()
Dim fs, f, f1, fc
Dim strReplacementText As String
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderspec)
Set fc = f.Files
'opens replacement file
Workbooks.Open strReplacementFile & "\" & strReplacementFileName
Cells(2, 1).Select 'assumes that there's a header row

For Each f1 In fc 'runs through all files
If f1.Name = strReplacementFileName Then GoTo NextFile
Workbooks.Open f1
Do
Workbooks(strReplacementFileName).Activate
strOldText = ActiveCell.Value
strNewText = ActiveCell.Offset(0, 1).Value
Workbooks(f1.Name).Activate
'runs through all sheets
For intCount = 1 To Workbooks(f1.Name).Worksheets.Count
Workbooks(f1.Name).Worksheets(intCount).Select
FindAnother:
Call FindText
If boolCannotFindAnymore = True Then
GoTo NextSheet
Else
GoTo FindAnother
End If
NextSheet:
Next intCount
Workbooks(strReplacementFileName).Activate
ActiveCell.Offset(1, 0).Select
Loop Until ActiveCell.Value = ""
Workbooks(f1.Name).Close True
NextFile:
Workbooks(strReplacementFileName).Activate
Cells(2, 1).Select
Next

Set fs = Nothing
Set f = Nothing
Set f1 = Nothing
Set fc = Nothing
Workbooks(strReplacementFileName).Close False
MsgBox "Completed processing files.", vbInformation
End Sub
Function FindText()
On Error Resume Next
Cells.Find(strOldText, Cells(1, 1), xlValues, xlWhole).Select

If Err.Number 0 Then
boolCannotFindAnymore = True
Err.Clear
Else
boolCannotFindAnymore = False
Call UpdateValue
End If
End Function
Function UpdateValue()
'updates colour and comment
Selection.Interior.ColorIndex = 36
ActiveCell.AddComment
ActiveCell.Comment.Visible = False
ActiveCell.Comment.Text Text:="Old Value:" & Chr(10) &
ActiveCell.Value
ActiveCell.Value = strNewText
End Function

FunkySquid

scojerroc wrote:

If you have more than a handful of replacement values, you may instead want
to creat a lookup table, then have the macro reference that. That would
eliminate your need for a "case" for every set of values.


"markx" wrote:


Hello guys,



I have 14 files (every of them with several tabs) where there are several
replacements to do.

55 old values need to be replaced with 12 new strings, f. ex:



old value_ to be replaced with new value_

apple 1 orange1

apple 2 orange1

apple 32 orange1

apple 8 orange22

pineapple21 orange22

pineapple5 orange22

pineapple3 orange22

pineapple43 orange22

grape1 orange444

grape122 orange444

.. .



Could you help me to write a macro that will :

1) treat all the files/tabs in the specified folder (f. ex. C:\test) -
I'll put there all the files that I want to change

2) make changes to them (all files, all tabs) based on the open file
"replacement_template.xls" (where I have column A (old values) and B (new
values))

3) highlight (in yellow) all the changed cells and put in comments to
the every changed cell the old value



Seems at the same time easy and complex to do.

In advance many thanks for any hints/draft solutions you could provide!

Regards,

Mark