Reference cell address of Hyperlink

[Mike Fogleman]

As I loop thru Hyperlinks, I need a reference to the active Hyperlink so I
can put a value in a cell Offset(0,7). See the first line following the
query

Option Explicit

Sub UpdateUsage()
Dim hyp As Hyperlink
Dim hypadr As String

For Each hyp In ActiveSheet.Range("K:K").Hyperlinks
hypadr = hyp.Address

With Worksheets("Update").QueryTables.Add(Connection:="URL;" & hypadr _
, Destination:=Range("A1"))
.name = ""
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlAllTables
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.Refresh BackgroundQuery:=False
End With

ActiveSheet.CurrentHyperlink.Offset(0, 7).Value = _
Worksheets("Update").Range("C7").Value ==>this is not right

With Worksheets("Update")
'do some other stuff
.Rows("1:7").Delete shift:=xlUp
End With
Next hyp
End Sub

Mike F

 

[Jim Cone]

Mike,

hypadr = hyp.Range.Address
ActiveSheet.Range(hypadr).Offset(0, 7).Value =...
ought to do it.

Regards,
Jim Cone
San Francisco, USA


As I loop thru Hyperlinks, I need a reference to the active Hyperlink so I
can put a value in a cell Offset(0,7). See the first line following the
query
Option Explicit
Sub UpdateUsage()
Dim hyp As Hyperlink
Dim hypadr As String

For Each hyp In ActiveSheet.Range("K:K").Hyperlinks
hypadr = hyp.Address

With Worksheets("Update").QueryTables.Add(Connection:="URL;" & hypadr _
, Destination:=Range("A1"))
.name = ""
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlAllTables
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.Refresh BackgroundQuery:=False
End With

ActiveSheet.CurrentHyperlink.Offset(0, 7).Value = _
Worksheets("Update").Range("C7").Value ==>this is not right

With Worksheets("Update")
'do some other stuff
.Rows("1:7").Delete shift:=xlUp
End With
Next hyp
End Sub

Mike F

 

[Mike Fogleman]

Not quite Jim, but I got it....

Sub UpdateUsage()
Dim hyp As Hyperlink
Dim hypadr As String
Dim hyprng As Range

For Each hyp In ActiveSheet.Range("K:K").Hyperlinks
hypadr = hyp.Address
Set hyprng = hyp.Range


Mike F

 

[Jim Cone]

Mike,
Are you sure about... hypadr = hyp.Address ?
Jim Cone


Not quite Jim, but I got it....

Sub UpdateUsage()
Dim hyp As Hyperlink
Dim hypadr As String
Dim hyprng As Range

For Each hyp In ActiveSheet.Range("K:K").Hyperlinks
hypadr = hyp.Address
Set hyprng = hyp.Range


Mike F

 

[Mike Fogleman]

Yes, I am now. here is the working code:
Sub UpdateUsage()
Dim hyp As Hyperlink
Dim hypadr As String
Dim hyprng As Range
Dim mystr As String
Dim myval As String
Dim i As Long

For Each hyp In ActiveSheet.Range("K:K").Hyperlinks
hypadr = hyp.Address
Set hyprng = hyp.Range
With Worksheets("Update").QueryTables.Add(Connection:="URL;" & hypadr _
, Destination:=Worksheets("Update").Range("A1"))
.name = ""
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlAllTables
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.Refresh BackgroundQuery:=False
End With
mystr = Worksheets("Update").Range("A3").Value

i = Application.WorksheetFunction.Find(" ", mystr, 5)
i = i - 5
myval = Mid(mystr, 5, i)
hyprng.Offset(0, 7).Value = myval
With Worksheets("Update")
.Rows("1:7").Delete Shift:=xlUp
End With
Next hyp
End Sub

Mike F