Excel Find/Replace issue ....

[TheBionicOrange]

I've got the following piece of code that picks up a graphical "up arrow", and replaces any cells with the value of "U" with this graphic.

intY = 1
        intX = 0
        .Range("K8").Select
        .ActiveSheet.Shapes("UpArrow").Select
        .Selection.Copy
        
        On Error GoTo Next_Type
        With .ActiveSheet
                .Cells.Find(What:="U", After:=objExcel.ActiveCell, LookIn:=xlFormulas, LookAt _
                    :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
                    False).Activate
            Do Until intX >= intY
                intX = objExcel.ActiveCell.row - 1
                tmpRow = intX
                tmpCol = objExcel.ActiveCell.Column
                objExcel.Selection.PasteSpecial xlPasteAll
                .Cells.FindNext(After:=objExcel.ActiveCell).Activate
                If tmpRow = objExcel.ActiveCell.row - 1 And tmpCol = objExcel.ActiveCell.Column Then Exit Do
                intY = objExcel.ActiveCell.row
            Loop
        End With

The problem I've got is this .... if the only "U" cells are on the same row then the routine goes round and round in circles.
It is unlikely, unfortunately it HAS just happened (typical Monday !) !!!

I don't actually like this way of doing things anyway, as it searches row by row and takes a few minutes to complete.

Does anyone know of a better way of replacing "U" cells with my "UpArrow" graphic ?

A single Find/Replace after highlighting the affected rows would be ideal, but I don't know how to assign my "UpArrow" graphic in the "Replace" box (I'm assuming you can't do it this way).

Can anyone help ?

Thanks in advance ....

[BrianB]

This is the basis of the usual Find/Replace method (copied from VB Editor Help) :-

With Worksheets(1).Range("a1:a500")
    Set c = .Find(2, lookin:=xlValues)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            c.Interior.Pattern = xlPatternGray50
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
End With

[Ecniv]

Hi,

I had this type of problem.. Its because the find doesn't move the cell...

Which is weird because it looks like you are checking for the cell being on the same row...

Do Until intX >= intY
                intX = objExcel.ActiveCell.row - 1
                tmpRow = intX
                tmpCol = objExcel.ActiveCell.Column
                objExcel.Selection.PasteSpecial xlPasteAll
                .Cells.FindNext(After:=objExcel.ActiveCell).Activate
                If tmpRow = objExcel.ActiveCell.row - 1 And tmpCol = objExcel.ActiveCell.Column Then Exit Do
                intY = objExcel.ActiveCell.row
            Loop

the do loop is infinite - mainly because if you are on the same cell, then inty is always one more than intx.

So the problem lies with the if statement and exiting.

If you put a breakpoint on it and see what the values are it will probably help you.
Alternatively, grab the address from the active cell and see if it matches the active cell after the find. If they are the same, leave the loop (or put it into the do until part).


Vince