Hi,
I am a network administrator for a Jr. High in Colorado and am new to Excel Macro writing. I have become stumped with a little project I am working on, a spreadsheet with links to various computers and resources and scripts I use in my day to day work. I discovered the mrexel.com message board at the end of last week and have been reading and learning more about Excel from posts on your board (and the blogs off the root domain) since then. I haven't been able to find what I needed through searches of past posts on this board, or through countless Google searches, so I thought maybe I could elect a kind soul's assistance with my question.
In this spreadsheet I have several macros I would like to execute via a hyperlink. I found a post in this message board that indicated this was possible by creating a hyperlink that points back to the same cell in the worksheet and then by adding code to the Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink) in the VB Editor. I have done this, and the macros I am using I have listed below. When I manually create the links using Excel's Insert > Hyperlink... menu, everything works exactly as I want it to. (I'd tried using a SelectionChange, at one point in my experimentation, but this broke the several of the macros).
What I need to do next I am not sure how to do. I have seven columns (F, G, H, I, J, K and L) that I need to fill (down) with hyperlinks that point back to its own cell. Through Excel I would do this through the Insert > Hyperlink... > Place in This Document. However, the number of cells I need to add hyperlinks for are to numerous to do this by hand. My first thought was fill in one row and then use Excel's Fill Down functionality. However, what I found was that the address's Cell Reference is duplicated instead of incremented when using any of the fill tricks I know (Fill menu, by using drag bar, by right clicking and dragging the drag bar, or holding down the Ctrl button). So instead of having links pointing to themselves, they instead all point to the first cell that was replicated (in my case that would be Row 11 of each of the columns mentioned).
Using the Record macro feature in Excel I was able to capture the creating of each one of these links. However, I'm not sure how to make this macro loop, nor how to increment the cell reference so that the hyperlink reference changes so that it pointing back to itself.
The columns/rows I am looking to fill are:
Column F: Rows 12-231 (Cell Reference Points to: itself, TextToDisplay: à)
Column G: Rows 12-231 (Cell Reference Points to: itself, TextToDisplay: Manage)
Column H: Rows 12-231 (Cell Reference Points to: itself, TextToDisplay: Connect Via Remote Desktop)
Column I: Rows 12-231 (Cell Reference Points to: itself, TextToDisplay: Open DameWare)
Column J: Rows 12-231 (Cell Reference Points to: itself, TextToDisplay: Log Off Computer)
Column K: Rows 12-231 (Cell Reference Points to: itself, TextToDisplay: See Who's Logged On)
Column L: Rows 12-231 (Cell Reference Points to: itself, TextToDisplay: ß)
(à and ß, when changed to WingDings, are arrows pointing to the right and left)
G11 will point to itself with the text "Manage", G12 will point to itself with the text "Manage" and so on and so forth through row 231. The next column over, H12 will point to itself with the text "Connect Via Remote Desktop", H13 will point to itself with the text "Connect Via Remote Desktop" and so on and so forth through row 231. And so on and so forth.
I hope this makes sense. Please let me know if I need to clarify anything.
Thanks Much for your help!!!
::: Macro Using Excel's Record Macro Feature :::
Sub AddRow()
'
' AddRow Macro
' Adds one row of links
'
' Keyboard Shortcut: Ctrl+Shift+M
'
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
"PCs!F13", TextToDisplay:="à"
Columns("F:F").Select
With Selection.Font
.Name = "Wingdings"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
End With
Range("G13").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
"PCs!G13", TextToDisplay:="Manage"
Range("H13").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
"PCs!H13", TextToDisplay:="Connect Via Remote Desktop"
Range("I13").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
"PCs!I13", TextToDisplay:="Open DameWare"
Range("J13").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
"PCs!J13", TextToDisplay:="Log Off Computer"
Range("K13").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
"PCs!K13", TextToDisplay:="See Who's Logged On"
Range("L13").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
"PCs!L13", TextToDisplay:="ß"
With Selection.Font
.Name = "Wingdings"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
End With
End Sub
::: Other Macros I am Using :::
Private Sub CommandButton1_Click()
If ActiveCell.Row > 10 Then
Static OldRange As Range
Static OldRange2 As Range
On Error Resume Next
Set OldRange2 = Target
Cells(Application.ActiveCell.Row, 5).Select
Cells(Application.ActiveCell.Row, 5).Interior.ColorIndex = 6 ' yellow - change as needed
Cells(Application.ActiveCell.Row, 13).Interior.ColorIndex = 6 ' yellow - change as needed
Selection.Copy
End If
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If ActiveCell.Row > 10 Then
Static OldRange As Range
Static OldRange2 As Range
On Error Resume Next
Set OldRange2 = Target
Cells(Application.ActiveCell.Row, 5).Select
Cells(Application.ActiveCell.Row, 5).Interior.ColorIndex = 6 ' yellow - change as needed
Cells(Application.ActiveCell.Row, 13).Interior.ColorIndex = 6 ' yellow - change as needed
Selection.Copy
End If
End Sub
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
On Error Resume Next
If ActiveCell.Column = 6 Then
Static OldRange4 As Range
On Error Resume Next
ActiveWindow.ScrollColumn = 6
Set OldRange4 = Target
Cells(Application.ActiveCell.Row, 5).Interior.ColorIndex = 6 ' yellow - change as needed
Cells(Application.ActiveCell.Row, 13).Interior.ColorIndex = 6 ' yellow - change as needed
End If
If ActiveCell.Column = 7 Then
ActiveWorkbook.FollowHyperlink Address:= _
"T:\Tech\Tech Private\BTC Frequently Accessed Files\compmgmt.msc"
GoTo SelectName
End If
If ActiveCell.Column = 8 Then
ActiveWorkbook.FollowHyperlink Address:= _
"T:\Tech\Tech Private\BTC Frequently Accessed Files\Launch Remote Desktop\Launch Remote Desktop.bat.lnk"
GoTo SelectName
End If
If ActiveCell.Column = 9 Then
ActiveWorkbook.FollowHyperlink Address:= _
"T:\Tech\Tech Private\BTC Frequently Accessed Files\Launch DameWare\Launch DameWare.bat.lnk"
GoTo SelectName
End If
If ActiveCell.Column = 10 Then
ActiveWorkbook.FollowHyperlink Address:= _
"T:\Tech\Tech Private\BTC Frequently Accessed Files\Log Off Remote Computer\Log Off Remote Computer.bat.lnk"
GoTo SelectName
End If
If ActiveCell.Column = 11 Then
ActiveWorkbook.FollowHyperlink Address:= _
"T:\Tech\Tech Private\BTC Frequently Accessed Files\See Who is Logged On to Remote Computer\See Who is Logged On to Remote Computer.bat.lnk"
GoTo SelectName
End If
If ActiveCell.Column = 12 Then
Static OldRange5 As Range
On Error Resume Next
ActiveWindow.ScrollColumn = 1
Set OldRange5 = Target
Cells(Application.ActiveCell.Row, 5).Interior.ColorIndex = 6 ' yellow - change as needed
Cells(Application.ActiveCell.Row, 13).Interior.ColorIndex = 6 ' yellow - change as needed
End If
Exit Sub
SelectName:
If ActiveCell.Row > 10 Then
Static OldRange As Range
Static OldRange2 As Range
On Error Resume Next
Set OldRange2 = Target
Cells(Application.ActiveCell.Row, 5).Select
Cells(Application.ActiveCell.Row, 5).Interior.ColorIndex = 6 ' yellow - change as needed
Cells(Application.ActiveCell.Row, 13).Interior.ColorIndex = 6 ' yellow - change as needed
Selection.Copy
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If ActiveCell.Row > 10 Then
Static OldRange As Range
Static OldRange2 As Range
On Error Resume Next
Cells(Application.ActiveCell.Row, 5).Interior.ColorIndex = 6 ' yellow - change as needed
Cells(Application.ActiveCell.Row, 13).Interior.ColorIndex = 6 ' yellow - change as needed
OldRange.Interior.ColorIndex = xlColorIndexNone
OldRange2.Interior.ColorIndex = xlColorIndexNone
Set OldRange = Cells(Application.ActiveCell.Row, 5)
Set OldRange2 = Cells(Application.ActiveCell.Row, 13)
End If
End Sub
I am a network administrator for a Jr. High in Colorado and am new to Excel Macro writing. I have become stumped with a little project I am working on, a spreadsheet with links to various computers and resources and scripts I use in my day to day work. I discovered the mrexel.com message board at the end of last week and have been reading and learning more about Excel from posts on your board (and the blogs off the root domain) since then. I haven't been able to find what I needed through searches of past posts on this board, or through countless Google searches, so I thought maybe I could elect a kind soul's assistance with my question.
In this spreadsheet I have several macros I would like to execute via a hyperlink. I found a post in this message board that indicated this was possible by creating a hyperlink that points back to the same cell in the worksheet and then by adding code to the Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink) in the VB Editor. I have done this, and the macros I am using I have listed below. When I manually create the links using Excel's Insert > Hyperlink... menu, everything works exactly as I want it to. (I'd tried using a SelectionChange, at one point in my experimentation, but this broke the several of the macros).
What I need to do next I am not sure how to do. I have seven columns (F, G, H, I, J, K and L) that I need to fill (down) with hyperlinks that point back to its own cell. Through Excel I would do this through the Insert > Hyperlink... > Place in This Document. However, the number of cells I need to add hyperlinks for are to numerous to do this by hand. My first thought was fill in one row and then use Excel's Fill Down functionality. However, what I found was that the address's Cell Reference is duplicated instead of incremented when using any of the fill tricks I know (Fill menu, by using drag bar, by right clicking and dragging the drag bar, or holding down the Ctrl button). So instead of having links pointing to themselves, they instead all point to the first cell that was replicated (in my case that would be Row 11 of each of the columns mentioned).
Using the Record macro feature in Excel I was able to capture the creating of each one of these links. However, I'm not sure how to make this macro loop, nor how to increment the cell reference so that the hyperlink reference changes so that it pointing back to itself.
The columns/rows I am looking to fill are:
Column F: Rows 12-231 (Cell Reference Points to: itself, TextToDisplay: à)
Column G: Rows 12-231 (Cell Reference Points to: itself, TextToDisplay: Manage)
Column H: Rows 12-231 (Cell Reference Points to: itself, TextToDisplay: Connect Via Remote Desktop)
Column I: Rows 12-231 (Cell Reference Points to: itself, TextToDisplay: Open DameWare)
Column J: Rows 12-231 (Cell Reference Points to: itself, TextToDisplay: Log Off Computer)
Column K: Rows 12-231 (Cell Reference Points to: itself, TextToDisplay: See Who's Logged On)
Column L: Rows 12-231 (Cell Reference Points to: itself, TextToDisplay: ß)
(à and ß, when changed to WingDings, are arrows pointing to the right and left)
G11 will point to itself with the text "Manage", G12 will point to itself with the text "Manage" and so on and so forth through row 231. The next column over, H12 will point to itself with the text "Connect Via Remote Desktop", H13 will point to itself with the text "Connect Via Remote Desktop" and so on and so forth through row 231. And so on and so forth.
I hope this makes sense. Please let me know if I need to clarify anything.
Thanks Much for your help!!!
::: Macro Using Excel's Record Macro Feature :::
Sub AddRow()
'
' AddRow Macro
' Adds one row of links
'
' Keyboard Shortcut: Ctrl+Shift+M
'
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
"PCs!F13", TextToDisplay:="à"
Columns("F:F").Select
With Selection.Font
.Name = "Wingdings"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
End With
Range("G13").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
"PCs!G13", TextToDisplay:="Manage"
Range("H13").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
"PCs!H13", TextToDisplay:="Connect Via Remote Desktop"
Range("I13").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
"PCs!I13", TextToDisplay:="Open DameWare"
Range("J13").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
"PCs!J13", TextToDisplay:="Log Off Computer"
Range("K13").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
"PCs!K13", TextToDisplay:="See Who's Logged On"
Range("L13").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
"PCs!L13", TextToDisplay:="ß"
With Selection.Font
.Name = "Wingdings"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
End With
End Sub
::: Other Macros I am Using :::
Private Sub CommandButton1_Click()
If ActiveCell.Row > 10 Then
Static OldRange As Range
Static OldRange2 As Range
On Error Resume Next
Set OldRange2 = Target
Cells(Application.ActiveCell.Row, 5).Select
Cells(Application.ActiveCell.Row, 5).Interior.ColorIndex = 6 ' yellow - change as needed
Cells(Application.ActiveCell.Row, 13).Interior.ColorIndex = 6 ' yellow - change as needed
Selection.Copy
End If
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If ActiveCell.Row > 10 Then
Static OldRange As Range
Static OldRange2 As Range
On Error Resume Next
Set OldRange2 = Target
Cells(Application.ActiveCell.Row, 5).Select
Cells(Application.ActiveCell.Row, 5).Interior.ColorIndex = 6 ' yellow - change as needed
Cells(Application.ActiveCell.Row, 13).Interior.ColorIndex = 6 ' yellow - change as needed
Selection.Copy
End If
End Sub
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
On Error Resume Next
If ActiveCell.Column = 6 Then
Static OldRange4 As Range
On Error Resume Next
ActiveWindow.ScrollColumn = 6
Set OldRange4 = Target
Cells(Application.ActiveCell.Row, 5).Interior.ColorIndex = 6 ' yellow - change as needed
Cells(Application.ActiveCell.Row, 13).Interior.ColorIndex = 6 ' yellow - change as needed
End If
If ActiveCell.Column = 7 Then
ActiveWorkbook.FollowHyperlink Address:= _
"T:\Tech\Tech Private\BTC Frequently Accessed Files\compmgmt.msc"
GoTo SelectName
End If
If ActiveCell.Column = 8 Then
ActiveWorkbook.FollowHyperlink Address:= _
"T:\Tech\Tech Private\BTC Frequently Accessed Files\Launch Remote Desktop\Launch Remote Desktop.bat.lnk"
GoTo SelectName
End If
If ActiveCell.Column = 9 Then
ActiveWorkbook.FollowHyperlink Address:= _
"T:\Tech\Tech Private\BTC Frequently Accessed Files\Launch DameWare\Launch DameWare.bat.lnk"
GoTo SelectName
End If
If ActiveCell.Column = 10 Then
ActiveWorkbook.FollowHyperlink Address:= _
"T:\Tech\Tech Private\BTC Frequently Accessed Files\Log Off Remote Computer\Log Off Remote Computer.bat.lnk"
GoTo SelectName
End If
If ActiveCell.Column = 11 Then
ActiveWorkbook.FollowHyperlink Address:= _
"T:\Tech\Tech Private\BTC Frequently Accessed Files\See Who is Logged On to Remote Computer\See Who is Logged On to Remote Computer.bat.lnk"
GoTo SelectName
End If
If ActiveCell.Column = 12 Then
Static OldRange5 As Range
On Error Resume Next
ActiveWindow.ScrollColumn = 1
Set OldRange5 = Target
Cells(Application.ActiveCell.Row, 5).Interior.ColorIndex = 6 ' yellow - change as needed
Cells(Application.ActiveCell.Row, 13).Interior.ColorIndex = 6 ' yellow - change as needed
End If
Exit Sub
SelectName:
If ActiveCell.Row > 10 Then
Static OldRange As Range
Static OldRange2 As Range
On Error Resume Next
Set OldRange2 = Target
Cells(Application.ActiveCell.Row, 5).Select
Cells(Application.ActiveCell.Row, 5).Interior.ColorIndex = 6 ' yellow - change as needed
Cells(Application.ActiveCell.Row, 13).Interior.ColorIndex = 6 ' yellow - change as needed
Selection.Copy
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If ActiveCell.Row > 10 Then
Static OldRange As Range
Static OldRange2 As Range
On Error Resume Next
Cells(Application.ActiveCell.Row, 5).Interior.ColorIndex = 6 ' yellow - change as needed
Cells(Application.ActiveCell.Row, 13).Interior.ColorIndex = 6 ' yellow - change as needed
OldRange.Interior.ColorIndex = xlColorIndexNone
OldRange2.Interior.ColorIndex = xlColorIndexNone
Set OldRange = Cells(Application.ActiveCell.Row, 5)
Set OldRange2 = Cells(Application.ActiveCell.Row, 13)
End If
End Sub