Help with Excel Hyperlinks macro?

[Victor Delta]

Using Excel 2003, I have three macros which I run, as appropriate, to the
format 3 types of hyperlink correctly. They are shown below.

What would be really helpful would be to combine them into one macro which
does the following to the cells, or cells, selected:
* First tests whether the cell(s) contain a hyperlink
* If so, applies the appropriate macro depending on which of the 3
types it is.

I've tried a few 'if' functions but so far VB has beaten me. Can anyone
help please?

Many thanks,

V

Sub MakeEmailHyperlinks()
For Each objCell In Selection.Cells
ActiveSheet.Hyperlinks.Add Anchor:=objCell, Address:="mailto:" &
objCell.Value, TextToDisplay:=objCell.Value
Next
End Sub

Sub MakeWebHyperlinks()
For Each objCell In Selection.Cells
ActiveSheet.Hyperlinks.Add Anchor:=objCell, Address:="http://" &
objCell.Value, TextToDisplay:=objCell.Value
Next
End Sub

Sub MakeFileHyperlinks()
For Each objCell In Selection.Cells
ActiveSheet.Hyperlinks.Add Anchor:=objCell, Address:="file:///" &
objCell.Value, TextToDisplay:=objCell.Value
Next
End Sub

 

[Clif McIrvin]

Using Excel 2003, I have three macros which I run, as appropriate, to
the format 3 types of hyperlink correctly. They are shown below.

What would be really helpful would be to combine them into one macro
which does the following to the cells, or cells, selected:
* First tests whether the cell(s) contain a hyperlink
* If so, applies the appropriate macro depending on which of the 3
types it is.

I've tried a few 'if' functions but so far VB has beaten me. Can
anyone help please?

Many thanks,

V

Sub MakeEmailHyperlinks()
For Each objCell In Selection.Cells
ActiveSheet.Hyperlinks.Add Anchor:=objCell, Address:="mailto:" &
objCell.Value, TextToDisplay:=objCell.Value
Next
End Sub

Sub MakeWebHyperlinks()
For Each objCell In Selection.Cells
ActiveSheet.Hyperlinks.Add Anchor:=objCell, Address:="http://" &
objCell.Value, TextToDisplay:=objCell.Value
Next
End Sub

Sub MakeFileHyperlinks()
For Each objCell In Selection.Cells
ActiveSheet.Hyperlinks.Add Anchor:=objCell, Address:="file:///" &
objCell.Value, TextToDisplay:=objCell.Value
Next
End Sub

Victor, I don't see where you told us how you decide which macro to run.
without that information, there isn't much that any of us can do to help
you out.

You might post the code you have attempted, as well.

 

[Victor Delta]

Victor, I don't see where you told us how you decide which macro to run.
without that information, there isn't much that any of us can do to help
you out.

You might post the code you have attempted, as well.

Clif

Thanks. The three tests I was planning to use in the if statements were:

If cells contain an '@' then use MakeEmailHyperlinks macro
If cells start with 'www.' then use MakeWebHyperlinks macro
If cells start with 'c:\' the use MakeFileHyperlinks macro
If cells contain none of the above, then end

Hope this helps?

V

 

[Clif McIrvin]

Clif

Thanks. The three tests I was planning to use in the if statements
were:

If cells contain an '@' then use MakeEmailHyperlinks macro
If cells start with 'www.' then use MakeWebHyperlinks macro
If cells start with 'c:\' the use MakeFileHyperlinks macro
If cells contain none of the above, then end

Hope this helps?

V

Untested air code:

Option Explicit

Sub MakeEmailHyperlinks(Optional r As Range)
Dim objCell As Range ' required by Option Explicit; recommended practice

' Use current selection if called w/o range parameter
If IsMissing(r) Then
Set r = Selection.Cells
End If
For Each objCell In r
' use range.Parent instead of Activesheet to allow
' use on a range from any sheet
r.Parent.Hyperlinks.Add Anchor:=objCell, _
Address:="mailto:" & objCell.Value, _
TextToDisplay:=objCell.Value
Next
Set r = Nothing
End Sub

Sub MakeHyperlinks()
'If cells contain an '@' then use MakeEmailHyperlinks macro
'If cells start with 'www.' then use MakeWebHyperlinks macro
'If cells start with 'c:\' the use MakeFileHyperlinks macro
'If cells contain none of the above, then end

Dim objCell As Range ' required by Option Explicit; recommended practice
Dim varData As Variant ' Cell Value

If TypeName(Selection) = "Range" Then ' test for selected cells
For Each objCell In Selection.Cells
If VarType(objCell.Value) = vbString Then ' ignore if not a string
value
varData = LCase(objCell.Value) ' get ready for lower case testing
If InStr(varData, "@") > 0 Then
MakeEmailHyperlinks objCell
ElseIf Left(varData, 4) = "www." Then
MakeWebHyperlinks objCell
ElseIf Left(varData, 3) = "c:\" Then
MakeFileHyperlinks objCell
End If
End If
End Sub

Use my modifications to MakeEmailHyperlinks as a pattern to revise your
other two subs.

Many developers strongly recommend always using Option Explicit (VBE
Window > Tools > Options > Editor > Require Variable Declaration) to
reduce the opportunity of erratic code failures caused by using the same
variable name multiple times and unexpectedly having two or more
procedures trying to use the same variable.

 

[Clif McIrvin]

Untested air code:

Option Explicit

Sub MakeEmailHyperlinks(Optional r As Range)
Dim objCell As Range ' required by Option Explicit; recommended
practice

' Use current selection if called w/o range parameter
If IsMissing(r) Then
Set r = Selection.Cells
End If
For Each objCell In r
' use range.Parent instead of Activesheet to allow
' use on a range from any sheet
r.Parent.Hyperlinks.Add Anchor:=objCell, _
Address:="mailto:" & objCell.Value, _
TextToDisplay:=objCell.Value
Next
Set r = Nothing
End Sub

Sub MakeHyperlinks()
'If cells contain an '@' then use MakeEmailHyperlinks macro
'If cells start with 'www.' then use MakeWebHyperlinks macro
'If cells start with 'c:\' the use MakeFileHyperlinks macro
'If cells contain none of the above, then end

Dim objCell As Range ' required by Option Explicit; recommended
practice
Dim varData As Variant ' Cell Value

If TypeName(Selection) = "Range" Then ' test for selected cells
For Each objCell In Selection.Cells
If VarType(objCell.Value) = vbString Then ' ignore if not a string
value
varData = LCase(objCell.Value) ' get ready for lower case testing
If InStr(varData, "@") > 0 Then
MakeEmailHyperlinks objCell
ElseIf Left(varData, 4) = "www." Then
MakeWebHyperlinks objCell
ElseIf Left(varData, 3) = "c:\" Then
MakeFileHyperlinks objCell
End If
End If
End Sub

Use my modifications to MakeEmailHyperlinks as a pattern to revise
your other two subs.

Many developers strongly recommend always using Option Explicit (VBE
Window > Tools > Options > Editor > Require Variable Declaration) to
reduce the opportunity of erratic code failures caused by using the
same variable name multiple times and unexpectedly having two or more
procedures trying to use the same variable.

Oops ... I forgot to close a couple code blocks:

End If
End If
End Sub


should be

End If ' contents testing
End If ' test for string value
Next objCell
End If ' test for selected cells
End Sub ' MakeHyperlinks

(Watch out for long lines that need to be put back together)

Also ... you could simply place your three Hyperlinks.Add statements
into the MakeHyperlinks code (instead of the various procedure calls).

 

[Victor Delta]

Oops ... I forgot to close a couple code blocks:

End If
End If
End Sub


should be

End If ' contents testing
End If ' test for string value
Next objCell
End If ' test for selected cells
End Sub ' MakeHyperlinks

(Watch out for long lines that need to be put back together)

Also ... you could simply place your three Hyperlinks.Add statements into
the MakeHyperlinks code (instead of the various procedure calls).

Clif

Very many thanks. I'll have a go and let you know how I get on!

V

 

[Victor Delta]

Clif

Very many thanks. I'll have a go and let you know how I get on!

V

Clif

Works perfectly! Very many thanks,

V