Excel Macro - find and replace

[MitchJP]

Hi all,

I'm trying to write a macro in Excel that will all instances of a word and replace it with an image. Any ideas? Is this possible? Ideally I'd like the image to be anchored to the cell that the word was in.

Thanks,
Mitch

 

[StuckInTheMiddle]

Hi there Mitch,

Good question, one which had me thinking for a little while, but I was able to combine 2 pieces of code together and come up with something for you.

In this code there are 3 things to note. 1 the ON ERROR RESUME NEXT is important because the FIND command generates an error when it doesn't find a cell containing the text you want. 2, when it finds that CELL it's important to clear it's contents so that the FIND doesn't keep on finding the same CELL again and again. 3. The Picture specified in the code has to exist, so replace this with the location and file you wish to have inserted.

Sub FindAndInsertPicture()
On Error Resume Next
Dim LookFor As String, ws As Worksheet
Dim p As Object, t As Double, l As Double, w As Double, h As Double
Dim PictureFileName  As String, sAddress As String

LookFor = "text to find"

PictureFileName = "c:\examples\Other\insert.jpg"

For Each ws In Worksheets

    sAddress = ws.Cells.Find(LookFor, , , , xlPart, False).Address
    Do While sAddress <> ""
        
        Set p = ActiveSheet.Pictures.Insert(PictureFileName)
        
        With ws.Range(sAddress)
            t = .Top
            l = .Left
            If CenterH Then
                w = .Offset(0, 1).Left - .Left
                l = l + w / 2 - p.Width / 2
                If l < 1 Then l = 1
            End If
            If CenterV Then
                h = .Offset(1, 0).Top - .Top
                t = t + h / 2 - p.Height / 2
                If t < 1 Then t = 1
            End If
            .Value = ""
        End With
        ' position picture
        With p
            .Top = t
            .Left = l
        End With
        sAddress = ws.Cells.Find(LookFor, , , xlPart, , xlNext, False).Address
    Loop
    
Next
End Sub

Hope this helps,

A,

 

[MitchJP]

Thanks for the help A!

One question, this appears to keep looping, and doesn't stop until I kill the macro. Any ideas?

 

[Loomah]

Hi
I've taken the code above and made amendments to the find and loop only (I've not changed anything to do with inserting the picture) using the Find and FindNext methods.

I've also removed the need for On Error Resume Next by actually checking for the error generated if no data is found.

Check out Find in the VBA help as the example given there is (IMHO) one of the best, and certainly most used by me, in the help files!

Sub FindAndInsertPicture()
'On Error Resume Next
Dim LookFor As String, ws As Worksheet
Dim p As Object, t As Double, l As Double, w As Double, h As Double
Dim PictureFileName  As String, sAddress As String

Dim c As Range

LookFor = "text to find"
PictureFileName = "c:\examples\Other\insert.jpg"

For Each ws In Worksheets
With ws

    Set c = .Cells.Find(LookFor, , , , xlPart, False)
    If Not c Is Nothing Then
        sAddress = c.Address
        
            Do
'                    Set p = ActiveSheet.Pictures.Insert(PictureFileName)
'                    With .Range(sAddress)
'                        t = .Top
'                        l = .Left
'                        If CenterH Then
'                            w = .Offset(0, 1).Left - .Left
'                            l = l + w / 2 - p.Width / 2
'                            If l < 1 Then l = 1
'                        End If
'                        If CenterV Then
'                            h = .Offset(1, 0).Top - .Top
'                            t = t + h / 2 - p.Height / 2
'                            If t < 1 Then t = 1
'                        End If
'                        .Value = ""
'                    End With
'                    ' position picture
'                    With p
'                        .Top = t
'                        .Left = l
'                    End With
                Set c = .Cells.FindNext(c)
            Loop While Not c Is Nothing And c.Address <> sAddress
    End If
End With
Next
End Sub

One picky point, please try to post VBA questions in the VBA forum!

;-)

If a man says something and there are no women there to hear him, is he still wrong?
How do I get the best answers?​

 

[MitchJP]

Thanks Loomah, when I run this macro it doesn't appear to do anything. It runs and nothing is replaced.

 

[MitchJP]

Actually, it's now running but once it replaces one instance of the text it's searching for, it appears to loop indefinitely.

Occasoinally I get an Object variable or With block not defined error as well, but only when there are no more instances of the target text found (or so it appears).

 

[Loomah]

hi
when you get the error if you debug the code which line is highlighted?

also, what happens if you just have 2 instances of "txt to look for" in your workbook and you step through the code line by line?

;-)

If a man says something and there are no women there to hear him, is he still wrong?
How do I get the best answers?​

 

[StuckInTheMiddle]

MitchJP

The code snippet I posted was meant to be a guideline to give you something to follow, it isn't loop indefinitely, it's search the contents of every cell in every sheet of your workbook.

A little modifiction to this code would be very simple and you can have it search the USEDRANGE for instance of a single sheet or however many you want, Best of luck

A,

 

[MitchJP]

When I debug, the cursor is on a different line every time. So it's replacing the first instance of the Text, then plugging the image into the same cell over and over.

 

[StuckInTheMiddle]

If you are using the amended code that Loomah pasted then i can see this happening, if you are using my original code which has the line '.Value = ""' in it , this won't happen

A,

 

[MitchJP]

Neither code sample works.... yet -

The original code deletes all instances of the target text, but then continues to loop until I break. No image is placed anywhere.

The second sample of code replaces the first instance of the target text and loops, placing the same image over and over in the same cell (where it first found the target text).

 

[StuckInTheMiddle]

Hi MitchJP,

My apologies to stop the infinite looping in my version of the code add sAddress = "" right before the last sAddress = ws....

I don't know why the picture wouldn't get replaced for you though unless the filepath to the image was wrong.

Hope this helps,

A,

 

[MitchJP]

Thanks A!

This is working perfectly now... You've been a lot of help! Thank you very much!

Mitch

 

[StuckInTheMiddle]

No problem, glad we got there in the end