Hey, tony h, sorry for the delay in getting back...

Here's the code. Some of it I did by "recording", the rest I winged it. I
get fowled up at the end... each time the sheet updates, the .bmps are
reinserted. I was trying to find the company name & if it's there replace it
with the bmp. Then, the next time the sheet is updated, if the bmp is there,
I don't want it to do anything. (This is just a small portion of a very
large set of macros which perform some automation.)

Up to the ElseIF portion it seems to run fine, but I don't kow how to stop
the code from reinserting the bmps, so I thought I could have it search for
the "extra" set each time and just delete it.

If you can help any further, I'd be obliged. (Does the "recorder" add
extraneous information -- more than you need to know?" It just seems so
cumbersome.)

Here's the code... thanks again, PS

Cells.Find(What:="ABC Co", After:=ActiveCell, LookIn:=xlFormulas _
, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Select
If ActiveCell.Value = "ABC Co" Then
Selection.ClearContents
ActiveSheet.Pictures.Insert("C:\Documents and Settings\PS\Desktop\ABC
Co\FileTransfer\Xmtls\XmtlLogo-DoNotRelocate.bmp").Select
' ActiveSheet.Pictures.Insert("H:\misc\XmtlLogo-DoNotRelocate.bmp").Select
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 12#
Selection.ShapeRange.Width = 78#
Selection.ShapeRange.Rotation = 0#
Selection.Name = "Logo"
With Selection
.Placement = xlFreeFloating
.PrintObject = True
End With
Selection.ShapeRange.IncrementTop 0.75
ActiveCell.Offset(rowOffset:=1, columnOffset:=0).Activate
ActiveCell.Select
ActiveSheet.Pictures.Insert("C:\Documents and Settings\PS\Desktop\ABC
Co\FileTransfer\Xmtls\Xmtl-em-DoNoRelocate.bmp").Select
' ActiveSheet.Pictures.Insert("H:\misc\Xmtl-em-DoNoRelocate.bmp").Select
Selection.Name = "EMsign"
With Selection
.Placement = xlFreeFloating
.PrintObject = True
End With
Selection.ShapeRange.IncrementTop 0.75
Selection.ShapeRange.IncrementTop 0.75
Selection.ShapeRange.IncrementTop 0.75

ElseIf ActiveSheet.Shapes.Find(What:="Logo", After:=ActiveCell,
LookIn:=xlFormulas _
, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate Then
ActiveSheet.Shapes(Array("Logo", "EMsign")).Delete

Sheets("TRANSMITAL").Select
End If

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios _
:=True
End Sub



"tony h" wrote:


You could post the code here


--
tony h
------------------------------------------------------------------------
tony h's Profile: http://www.excelforum.com/member.php...o&userid=21074
View this thread: http://www.excelforum.com/showthread...hreadid=530701