Showing result in For Each statement

[jclu]

Hi, I'm trying to go through a worksheet, and look in the formulas of each of the cells, and if I find a particular string, change it. I'm basing my code on http://www.mrexcel.com/tip034.shtml.

Anyway, here's my code:

ActiveWorkbook.Worksheets(i).Activate
Range("A1", ActiveCell.SpecialCells(xlLastCell)).Select

For Each cell In Selection            
    RefPos = InStr(1, cell.FormulaR1C1, "6454", vbTextCompare)
    If RefPos > 0 Then
        Dim Result
        Result = MsgBox(cell.FormulaR1C1, vbOKOnly)
    End If       
Next

This works fine, but the problem is that it will show the sheet, show all the cells highlighted and the message box will just contain the contents of the matched cell's formula. I want to allow the user to see the actual matched cell, because I then want to give the user the option to decide whether to replace the contents or not.

Essentially I want to do the same thing that you get when you use the Replace menu function in the workbook (ie, go to Edit -> Replace), and instead of clicking on "Replace All", you click on "Find Next." As the user, you can then see what the next matched cell is, and if you choose to replace it, you can then click on "Replace."

I tried the line

Result = MsgBox(cell.FormulaR1C1 & "; " & cell.Address, vbOKOnly)

but that still doesn't help because it just prints out the A1 style reference. Unfortunately, I don't know how to then allow the user to scroll to that reference or to display that reference on the screen. The other thing that worries me is that even when the msg box pops up, the contents of sheet are still highlighted, and if I add in a line that selects the matched cell based on cell.Address, I'm afraid that will screw up my For Each statement.

Thank you for any help you can provide me.

 

[BrianB]

I think this is what you want :-

''========================================================================================
'- FIND & REPLACE CELLS DEPENDING ON CONTENT
'- MESSAGE CHECKS FOR REPLACEMENT
'- Brian Baulsom January 2005
'=========================================================================================
Sub FindReplace()
    Dim ws As Worksheet
    Dim MyFind As Variant
    Dim MyNewValue As Variant
    Dim FoundCell As Object
    Dim Counter As Long
    Dim rsp
    '-------------------------------------------------------------------------------------
    MyFind = InputBox("Please insert value to find.", " FIND")
    If MyFind = "" Then End
    '---------------------------
    MyNewValue = InputBox("Please insert value to replace.", " REPLACE")
    If MyNewValue = "" Then End
    '-------------------------------------------------------------------------------------
    '- FIND CELL
    '- trap error when Replace leaves no more to Find
    On Error GoTo Finish
    '-
    Counter = 0
    Set ws = ActiveSheet
    ws.Range("A1").Select
    '-
    Set FoundCell = ws.Cells.Find(What:=MyFind, AFTER:=ws.Range("A1"), MatchCase:=False)
    If Not FoundCell Is Nothing Then
        FirstAddress = FoundCell.Address
        Do
            Counter = Counter + 1
            '------------------------------------------------------------------------------
            '- what to do if found
            '- 1. Make sure cell is visible. Check replace
            Application.Goto REFERENCE:=FoundCell, scroll:=True
            '------------------------------------------------------------------------------
            '- 2. Check replace
            rsp = MsgBox("Do you wish to replace ... " & MyFind & vbCr _
                       & "with ......................... " & MyNewValue & vbCr _
                       & "in cell ............. " & FoundCell.Address & "?", vbYesNoCancel)
            If rsp = vbCancel Then Exit Sub
            '-------------------------------------------------------------------------
            '- 3. replace
            If rsp = vbYes Then
                ActiveCell.Replace What:=MyFind, Replacement:=MyNewValue, _
                    LookAt:=xlPart, MatchCase:=False
            End If
            '-------------------------------------------------------------------------
            '- next
            Set FoundCell = ws.Cells.FindNext(FoundCell)
        Loop While Not FoundCell Is Nothing And FoundCell.Address <> FirstAddress
    End If
    '----------------------------------------------------------------------------------
    '- finish
Finish:
    Application.Goto REFERENCE:=ws.Range("A1")
    rsp = MsgBox("Found " & Counter)
End Sub
'--------------------------------------------------------------------------------------

 

[jclu]

Thanks BrianB, there's definitely some syntax in there that I've never encountered before, but it's pretty self-explanatory, and that's how I'm going to learn anyway!

I was wondering why you have the loop inside the first if statement? I would probably have put in the if statement first, with the FirstAddress var being updated within the if statement, and then had the do loop with the condition of the loop at the do line, as below:

If Not FoundCell Is Nothing Then 
    FirstAddress = FoundCell.Address 
End If 

Do While Not FoundCell Is Nothing And FoundCell.Address <> FirstAddress
'...contents in loop
Loop

Would this work as well? Thanks again.

 

[BrianB]

If Not FoundCell Is Nothing Then
FirstAddress = FoundCell.Address
End If

Do While Not FoundCell Is Nothing And FoundCell.Address <> FirstAddress
'...contents in loop
Loop

Would this work as well? Thanks again.

You could have tried this yourself ..... and found that it doesn't work.
The loop conditions are met immediately - so it doesn't run.

Using 'Do ...... Loop While .. ' ensures that the loop will run at least once.