Find numeric characters found within cell text and convert to hyperlink

Thread view:

Enable EMail Alerts

Start New Thread

Thread rating:

CJ - 27 Nov 2007 22:33 GMT

Scenario:
IF a cell in column D, contains *any* number within *any* text, then
convert *each* number to a hyperlink.

In my spreadsheet I have:
Cell D6 = 821-incorrect fonts
Cell D7 = blank
Cell D8 = 821-incorrect fonts, 834-misaligned page

What I want to have here is a macro to convert the above cell contents
to this:
Cell D6 = =HYPERLINK("http://qabugzilla.lagarde.com/show_bug.cgi?
id=821","821-incorrect fonts")
Cell D7 = blank
Cell D8 = =HYPERLINK("http://qabugzilla.lagarde.com/show_bug.cgi?
id=821","821-incorrect fonts") & HYPERLINK("http://
qabugzilla.lagarde.com/show_bug.cgi?id=834","834-misaligned page")

Below is what I've got started, it obviously doesn't complete what I'm
looking for.
What I know that I'm missing in my macro is:
1. I am using cell.value instead of finding the number within the
cell.value to add to the hyperlinkaddress.
2. I don't know how to create two separate hyperlinks within a single
cell. (I'm not sure this is possible.)

Can anyone offer some help with this? Thanks a million in advance!

Sub MakeBugHyperlinks()
Dim cell As Range
Dim path As String
Dim bugNo As String
Dim HyperlinkAddress As String

path = "http://qabugzilla.domain.com/show_bug.cgi?id="

For Each cell In Intersect(Selection, ActiveSheet.UsedRange)
bugNo = cell.Value
HyperlinkAddress = path & bugNo
cell.Formula = "=HYPERLINK(""" & HyperlinkAddress & _
""",""" & bugNo & """)"
Next cell

End Sub

Reply to this Message

carlo - 28 Nov 2007 00:42 GMT

I made this sub and this function:
What you need to do is fill out the Array a_bugs with the numbers you
have.
If you don't want to have them in an array, you can change the sub of
course, so that it looks at a range or whatever pleases you.
If you have problems with changing the sub, just ask.
'--------------------------------------------------------------------------------
Sub BugReplacer()

a_bugs = Array(821, 823)

Set BugRange = Intersect(Selection, ActiveSheet.UsedRange)

If BugRange Is Nothing Then
Exit Sub
End If

For Each BugCell In BugRange
For j = 0 To UBound(a_bugs)
If InStr(1, BugCell.Value, a_bugs(j)) > 0 Then
BugCell.FormulaR1C1 = BugText(a_bugs(j), BugCell.Value)
Exit For
End If
Next j
Next BugCell

End Sub
'--------------------------------------------------------------------------------
Function BugText(BugNumber As Variant, BugTextOrig As String) As
String

Dim BugPath As String

BugPath = "http://qabugzilla.domain.com/show_bug.cgi?id=" & BugNumber

BugText = "=HYPERLINK(""" & BugPath & """, """ & BugTextOrig & """)"

End Function
'--------------------------------------------------------------------------------

hth

Carlo

> Scenario:
> IF a cell in column D, contains *any* number within *any* text, then
[quoted text clipped - 40 lines]
>
> End Sub

Reply to this Message