automatic replacement macro (follow up)

[markx]

Hello everybody,

Just getting back to you with my question from yesterday (sorry if I'm not
patient enough, but maybe it was lost in the middle of all threads...).

I have a really beatiful code provided by one of you that enables automatic
replacements in column A of every sheet and every workbook in the specified
location. The only thing I would like to change (I don't know if it's easy
or not...) is to consider not only the column A but all the values on the
whole sheet (or at least in the current region). It would be also good to
"get rid of" message box (it gives too many alerts...) I tried to modify it
yesterday during several hours by myself, but my current VBA skills are not
good enough...

Below, I paste the original code (to be modified. if possible).
Thanks a lot for your help on this!!!
Mark
__________________________________________
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 "apple1", "apple2", "apple32"
strReplacementText = "orange1"
Case "apple8", "pineapple21", "pineapple5", "pineapple3",
"pineapple43"
strReplacementText = "orange22"
Case "grape1", "grape122"
strReplacementText = "orange444"
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
_____________________________________________