Glad I could help.

Max wrote:

Dave, thanks for the variation !
It runs great. Much appreciated.
I'm glad to have the 2 options ready to apply.
--
Max
Singapore
http://savefile.com/projects/236895
xdemechanik
---
"Dave Peterson" wrote in message
...
How about:

Option Explicit
Sub testme()

Dim wks As Worksheet
Dim myFormula As String
Dim QuotePos As Long
Dim myRng As Range
Dim myCell As Range

Set wks = ActiveSheet
With wks
Set myRng = Nothing
On Error Resume Next
Set myRng = Intersect(Selection, .UsedRange)
On Error GoTo 0
End With

If myRng Is Nothing Then
MsgBox "not in the used range"
Exit Sub
End If

For Each myCell In myRng.Cells
If myCell.HasFormula Then
myFormula = LCase(myCell.Formula)
If myFormula Like "=hyperlink(""*" Then
myFormula = Mid(myFormula, 13)
QuotePos = InStr(1, myFormula, Chr(34), vbTextCompare)
If QuotePos = 0 Then
'do nothing
Else
myFormula = Left(myFormula, QuotePos - 1)
If myCell.Column 1 Then
myCell.Offset(0, -1).Value = myFormula
End If
Select Case Right(myFormula, 4)
Case Is = ".jpg", ".bmp", ".gif"
Call InsertPicComment(myCell, _
myFormula)
End Select
End If
End If
End If
Next myCell


End Sub
Sub InsertPicComment(myCell As Range, PictFileName As String)

Dim testStr As String

testStr = ""
On Error Resume Next
testStr = Dir(PictFileName)
On Error GoTo 0

If testStr = "" Then
'do nothing, picture not found
Else
If myCell.Comment Is Nothing Then
myCell.AddComment Text:=testStr
Else
myCell.Comment.Text Text:=myCell.Comment.Text & "--" & testStr
End If
myCell.Comment.Shape.Fill.UserPicture PictFileName
End If

End Sub

--

Dave Peterson