PDA

View Full Version : Solved: Modify Hyperlink Code



Emoncada
10-13-2009, 11:25 AM
I have the following vbscript


Sub tracking()
Dim Trackingnr As String
Dim mytrace As String
Dim mylastcell As Long
Dim activerow As Long


mylastcell = ActiveSheet.Range("D65536").End(xlUp).Row
activerow = 3 'replace 1 with the first row where the tracking number appears

Do While activerow < mylastcell + 1
Trackingnr = Trim(Range("D" & activerow).Value) 'replace "A" with the actual column
mytrace = """http:\\wwwapps.ups.com/WebTracking/track?HTMLVersion=5.0&loc=en_US&Requester=UPSHome&trackNums=" & Trackingnr & "+&track.x=Track"""

Range("D" & activerow).Formula = "=HYPERLINK(" & mytrace & ",""" & Trackingnr & """)" 'replace "A" with the actual column
activerow = activerow + 1
Loop

End Sub


This works perfectly, but what I need it to do now is a little more difficult.
I want it to hyperlink all cells in a the active row across multiple columns.

Can someone help modify this to work for me.

Thanks

Bob Phillips
10-13-2009, 03:15 PM
Untested



Sub tracking()
Dim Trackingnr As String
Dim mytrace As String
Dim mylastcell As Long
Dim activerow As Long
Dim lastcol As Long
Dim j As Long

mylastcell = ActiveSheet.Range("D65536").End(xlUp).Row
activerow = 3 'replace 1 with the first row where the tracking number appears

Do While activerow < mylastcell + 1

lastcol = .Cells(activerow, .Columns.Count).End(xlToLeft).Column
For j = 4 To lastcol

Trackingnr = Trim(Cells(activerow, j).Value) 'replace "A" with the actual column
mytrace = """http:\\wwwapps.ups.com/WebTracking/track?HTMLVersion=5.0&loc=en_US&Requester=UPSHome&trackNums=" & Trackingnr & "+&track.x=Track"""

Cells(activerow, j).Formula = "=HYPERLINK(" & mytrace & ",""" & Trackingnr & """)" 'replace "A" with the actual column
activerow = activerow + 1
Next j
Loop

End Sub

Emoncada
10-13-2009, 04:51 PM
It's Giving me a compile error: Invalid or unqualified reference
"lastcol = .Cells(activerow, .Columns.Count).End(xlToLeft).Column"

Any Ideas why?
Also you still have the ("D65536") Now I need this to work for all columns not only D will this still work?

Bob Phillips
10-14-2009, 12:32 AM
It's Giving me a compile error: Invalid or unqualified reference
"lastcol = .Cells(activerow, .Columns.Count).End(xlToLeft).Column"

Any Ideas why?

There is no encompassing With, so remove the dots

lastcol = Cells(activerow, Columns.Count


Also you still have the ("D65536") Now I need this to work for all columns not only D will this still work?

You still have to have a key column to determine the last row.

GTO
10-14-2009, 12:48 AM
Greetings,

I read this a bit differently.

Are you now trying to change values to hyperlinks in a rectangular range, let's say by example: D3:J20 ?

Or are you just trying to do this in one row (instead of one column)?

Mark

GTO
10-14-2009, 01:29 AM
Hey again,

To try XLD's, here it is without the dots and a slight tweak to where we put activerow = activerow + 1 ...

Sub tracking()
Dim Trackingnr As String
Dim mytrace As String
Dim mylastcell As Long
Dim activerow As Long
Dim lastcol As Long
Dim j As Long

mylastcell = ActiveSheet.Range("D65536").End(xlUp).Row
activerow = 3 'replace 1 with the first row where the tracking number appears

Do While activerow < mylastcell + 1

lastcol = Cells(activerow, Columns.Count).End(xlToLeft).Column
For j = 4 To lastcol

Trackingnr = Trim(Cells(activerow, j).Value) 'replace "A" with the actual column
mytrace = """http:\\wwwapps.ups.com/WebTracking/track?HTMLVersion=5.0&loc=en_US&Requester=UPSHome&trackNums=" & Trackingnr & "+&track.x=Track"""

Cells(activerow, j).Formula = "=HYPERLINK(" & mytrace & ",""" & Trackingnr & """)" 'replace "A" with the actual column
Next j
activerow = activerow + 1
Loop
End Sub

Emoncada
10-14-2009, 06:00 AM
Basically what im trying to do is this.
I have a form that i enter serial numbers and tracking numbers.
What Im trying to do is this, once I enter all the serial numbers and tracking numbers, I want the data to go like this.
First available row enter Serial numbers across then next row will have the tracking Numbers right underneath the serial numbers. Then a row with
"'=============".
Now I can get the data there the problem is hyperlinking the second row which is the tracking Numbers. I want to be able to click on it and have it go to ups and show the tracking information for that tracking number.
Currently this isn't working.

Emoncada
10-14-2009, 06:27 AM
So I am using this
Sub tracking()
Dim Trackingnr As String
Dim mytrace As String
Dim mylastcell As Long
Dim activerow As Long
Dim lastcol As Long
Dim j As Long

mylastcell = ActiveSheet.Range("B65536").End(xlUp).Row
activerow = 3 'replace 1 with the first row where the tracking number appears

Do While activerow < mylastcell + 1

lastcol = Cells(activerow, Columns.Count).End(xlToLeft).Column
For j = 2 To lastcol

Trackingnr = Trim(Cells(activerow, j).Value) 'replace "A" with the actual column
mytrace = """http:\\wwwapps.ups.com/WebTracking/track?HTMLVersion=5.0&loc=en_US&Requester=UPSHome&trackNums=" & Trackingnr & "+&track.x=Track"""

Cells(activerow, j).Formula = "=HYPERLINK(" & mytrace & ",""" & Trackingnr & """)" 'replace "A" with the actual column

Next j
activerow = activerow + 1
Loop

End Sub
It works great for the first one. The Problem is the nest time I run it, it hyperlinks The Previous "'=============" row then the new Serial Numbers and the Tracking Numbers. Instead of just hyperlinking the new Tracking Row.

Bob Phillips
10-14-2009, 09:01 AM
How about a workbook, I am struggling to see it?

Emoncada
10-14-2009, 09:09 AM
Attached is a copy of the worksheet. As you can see the code hyperlinks other rows the second time I ran the code. This doesn't have the form attached because I have company information on it. I can try to make a duplicate workbook without the company info if needed, will take some time though. Hope this helps. Thanks

Emoncada
10-15-2009, 05:20 AM
BUMP!

Emoncada
10-16-2009, 06:33 AM
Is there a way I can just hyperlink the cell as it's being placed?

Emoncada
10-19-2009, 07:54 AM
BUMP

Bob Phillips
10-19-2009, 08:49 AM
This works as I see it



Sub tracking()
Const TRACKING_ROOT As String = _
"http:\\wwwapps.ups.com/WebTracking/track?HTMLVersion=5.0&loc=en_US&Requester=UPSHome&trackNums="
Dim Trackingnr As String
Dim mytrace As String
Dim LastRow As Long
Dim LastCol As Long
Dim i As Long, j As Long

LastRow = ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row

For i = 3 To LastRow Step 3

LastCol = Cells(i, Columns.Count).End(xlToLeft).Column
For j = 2 To LastCol

Trackingnr = Trim(Cells(i, j).Value)
mytrace = """" & TRACKING_ROOT & Trackingnr & "+&track.x=Track"""

Cells(i, j).Formula = "=HYPERLINK(" & mytrace & ",""" & Trackingnr & """)"
Next j
Next i

End Sub

Emoncada
10-19-2009, 09:10 AM
PERFECT!!!!!
Thanks for coming thru once again XLD.

I appreciate the help.