Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
automatic replacement macro (follow up)
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 _____________________________________________ |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Follow Up Macro Question | Excel Discussion (Misc queries) | |||
Value Replacement | Excel Worksheet Functions | |||
Why can't I record "flag for follow up" as a Macro? | Excel Discussion (Misc queries) | |||
Replacement | Excel Programming | |||
Macro assignations follow new documents | Excel Programming |