View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
Jim May Jim May is offline
external usenet poster
 
Posts: 430
Default advanced "Replace" macro = correction

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