MichaelATO
03-17-2007, 01:07 PM
Hi all;
I have been given the task of shrinking a worksheet in size. part of the problem is that two columns in the sheet contain "active" hyperlinks to an intranet personnel directory. these I am going to remove and replace their values with a VBA module that will create the hyperlink by appending a userid at the end to make the connection to the intrante personnel directory.
I would like to have the code do the follwing:
Use double click event on name of individual in sheet 1.
Find individual (column 1) on sheet two and using offset function, go to column 2 to locate the userid on found record.
Concatenate the URL, which is part of the vba, of the directory listing to the userid. This would look then like http://xxxxetc=UserId.
Activate the hyperlink created and jump to the directory listing.
Sheet 2 should be hidden as the userid should not be visible.
Would anyone be able to assist in this please? Thanks. the code thus far is (note file attached):
The code of course still does not work. Can anyone please assist? thanks
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal _
Target As Range, Cancel As Boolean)
Dim Link As String
Dim cell As Range
Dim svalue As String 'string to look for is svalue and is filled with a value
'when you doubleclicked your worksheet
Dim lrow As Long 'last row of data
Dim UserId As String 'Userid is offset to euivalent svalue in "Directory" worksheet
svalue = Worksheets("LAC List").ActiveCell.Value
lrow = Worksheets("Directory").Range("A" & Rows.Count).End(xlUp).Row
UserId = Worksheets("Directory").Offset(0, 1).Value
Link = "http://cbr07sap200:1083/UserInfo.asp?userid=" & UserId
If (Target.Column <> 6 And Target.Column <> 7) Then Exit Sub
If Target.Row = 1 Then Exit Sub
On Error Resume Next
Cancel = True 'Get out of edit mode
Worksheets("Directory").Activate
For Each cell In Worksheets("Directory").Range("A2:A" & lrow)
'look for matching values
If cell Like "*" & svalue & "*" Then
cell.Offset(0, 1).Value
If Worksheets(Target.Value) Is Nothing Then
MsgBox Target.Value & " -- Not Listed. Please check the Directory"
End If
End Sub
I have been given the task of shrinking a worksheet in size. part of the problem is that two columns in the sheet contain "active" hyperlinks to an intranet personnel directory. these I am going to remove and replace their values with a VBA module that will create the hyperlink by appending a userid at the end to make the connection to the intrante personnel directory.
I would like to have the code do the follwing:
Use double click event on name of individual in sheet 1.
Find individual (column 1) on sheet two and using offset function, go to column 2 to locate the userid on found record.
Concatenate the URL, which is part of the vba, of the directory listing to the userid. This would look then like http://xxxxetc=UserId.
Activate the hyperlink created and jump to the directory listing.
Sheet 2 should be hidden as the userid should not be visible.
Would anyone be able to assist in this please? Thanks. the code thus far is (note file attached):
The code of course still does not work. Can anyone please assist? thanks
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal _
Target As Range, Cancel As Boolean)
Dim Link As String
Dim cell As Range
Dim svalue As String 'string to look for is svalue and is filled with a value
'when you doubleclicked your worksheet
Dim lrow As Long 'last row of data
Dim UserId As String 'Userid is offset to euivalent svalue in "Directory" worksheet
svalue = Worksheets("LAC List").ActiveCell.Value
lrow = Worksheets("Directory").Range("A" & Rows.Count).End(xlUp).Row
UserId = Worksheets("Directory").Offset(0, 1).Value
Link = "http://cbr07sap200:1083/UserInfo.asp?userid=" & UserId
If (Target.Column <> 6 And Target.Column <> 7) Then Exit Sub
If Target.Row = 1 Then Exit Sub
On Error Resume Next
Cancel = True 'Get out of edit mode
Worksheets("Directory").Activate
For Each cell In Worksheets("Directory").Range("A2:A" & lrow)
'look for matching values
If cell Like "*" & svalue & "*" Then
cell.Offset(0, 1).Value
If Worksheets(Target.Value) Is Nothing Then
MsgBox Target.Value & " -- Not Listed. Please check the Directory"
End If
End Sub