If you could, how would it know which one to follow?
If you could, how would it know which one to follow?
Hi Bob,
Actually, this would be ideal. For example, we have a spreadsheet that itemizes process steps by Row. For that same row, the process step is associated with multiple artifacts or hyperlinks, with the full UNC path to the artifact (the full path tells me which link to follow). For metric purposes, even though we have multiple artifacts, it still counts as 1 process step. This probably could be better served in a database, but I find Excel far easier to manipulate.
I have no idea if this can be done, but it would sure be a nice feature have available.
Hi Gary,
I think you're out of luck on this one. I can't think of any way to get mutliple hyperlinks into a single cell.
Ken Puls, FCPA, FCMA, MS MVP
Learn to Master Your Data at the Power Query Academy (the world's most comprehensive online Power Query training), with my book M is for Data Monkey, or our new Power Query Recipe cards!
Main Site: http://www.excelguru.ca -||- Blog: http://www.excelguru.ca/blog -||- Forums: http://www.excelguru.ca/forums
Check out the Excelguru Facebook Fan Page -||- Follow Me on Twitter
If you've been given VBA code (a macro) for your solution, but don't know where to put it, CLICK HERE.
I would like to run this by you and maybe you can offer some guidance on its implementation.
1. Format the target cell for multiple lines (ALT + ENTER)
2. On each line put a different Path to a file, folder or URL.
Note: These cells would always be formatted this way.
3. Create a Macro (SENDKEYS) to select the specific line (1, 2, 3, 4 or 5) in the Active Cell and copy it to the clipboard or an array, convert the contents of the clipboard or array(value) to a hyperlink and navigate the path.
Last edited by GaryA; 2012-05-02 at 01:08 AM.
Well, I have put multiple paths in a single cell, on separate lines, CHR(10), and can navigate to the individual paths by using Chandoos SplitCell routines and grabbing a target path. See attachment.
However, it is not yet complete. I need to assign keyboard macros to the target paths. For some reason, the Application.OnKey "^1", "Nav_Hyp1" is not working. Any ideas?
Here is the code:
Sub Nav_Hyp1()
On Error Resume Next
Range("MultiLink").Select
'splits Text active cell using ALT+10 char as separator
Dim splitVals As Variant
Dim totalVals As Long
splitVals = Split(ActiveCell.Value, Chr(10))
totalVals = UBound(splitVals)
Hyp1 = splitVals(0)
Hyp2 = splitVals(1)
Hyp3 = splitVals(2)
Hyp4 = splitVals(3)
Hyp5 = splitVals(4)
ActiveWorkbook.FollowHyperlink Address:=Hyp1, NewWindow:=True
Application.OnKey "^1", "Nav_Hyp1"
End Sub
Done it! Had to add the following code to the "ThisWorkbook" Module. Updated file attached.
Private Sub Workbook_Activate()
Application.OnKey "^1", "Nav_Hyp1"
Application.OnKey "^2", "Nav_Hyp2"
Application.OnKey "^3", "Nav_Hyp3"
Application.OnKey "^4", "Nav_Hyp4"
Application.OnKey "^5", "Nav_Hyp5"
End Sub
Private Sub Workbook_Deactivate()
Application.OnKey "^1", ""
Application.OnKey "^2", ""
Application.OnKey "^3", ""
Application.OnKey "^4", ""
Application.OnKey "^5", ""
End Sub
How would you go about assigning the "Left Mouse button" + "1" combination to lauch a macro? It would give you more of the feel of clicking on an actual hyperlink in the cell.
Last edited by GaryA; 2012-05-03 at 12:11 AM.
Hi Gary,
Way to go! I'm glad you got that part worked out.
With regards to capturing the "Left Mouse Button" + 1 combination, I'm not sure how realistic that is. The issue is that when you left click that immediately triggers an action. When you press the number one, the same thing. The mouse button is not like the CTRL or ALT keys in that regard that wait for a secondary input.
There are a couple of Worksheet events that you might be able to use though... a double click and a right click event. Their signatures are:
Alternately, you could pop up a box on doubleclick asking them which of the five links you want to follow. You could have that autopopulate from in a userform. So basically you'd double click the cell, then click on the desired link. Would that work?Code:Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) End Sub Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) End Sub
Ken Puls, FCPA, FCMA, MS MVP
Learn to Master Your Data at the Power Query Academy (the world's most comprehensive online Power Query training), with my book M is for Data Monkey, or our new Power Query Recipe cards!
Main Site: http://www.excelguru.ca -||- Blog: http://www.excelguru.ca/blog -||- Forums: http://www.excelguru.ca/forums
Check out the Excelguru Facebook Fan Page -||- Follow Me on Twitter
If you've been given VBA code (a macro) for your solution, but don't know where to put it, CLICK HERE.
Hi Ken, I got side tracked with trying to validate the individual links on the separate lines. I modified the check-links code to determine the start and stop characters values for each line, then attempt to change the color of the line depending on the link valiation. Link validation seems to work for all individual lines but it fails to highlight the text start/stop correctly. I removed all the CHR(10)'s during debug thinking that may have something to do with it, but I get the same problem.
Nav_Hyp1_Link_Checks Works: It validated the first link and updated the color of line 1 correctly.
Nav_Hyp2_Link_Checks Fails: It validated the second link but does not update the color of the second line based on start/stop correctly.
Code:Sub Nav_Hyp1_Link_Checks() 'On Error Resume Next Range("MultiLink").Select 'splits Text active cell using ALT+10 char as separator Dim splitVals As Variant Dim totalVals As Long Dim bNoRights As Boolean splitVals = Split(ActiveCell.Value, Chr(10)) totalVals = UBound(splitVals) Hyp1 = splitVals(0) Hyp2 = splitVals(1) 'Get Line 1 Range Start1 = InStr(Range("MultiLink").Value, Hyp1) End1 = InStr(Range("MultiLink").Value, Hyp2) - 2 '*********************************************************************** ' Hyperlink Validation - Check multilink line in single cell '*********************************************************************** ExistPath = False If Left(Hyp1, 7) = "http://" Or Left(Hyp1, 8) = "https://" Or Left(Hyp1, 6) = "ftp://" Or Left(Hyp1, 7) = "ftps://" Then ExistPath = InternetCheckConnection(Hyp1, 1, 0) '1=FLAG_ICC_FORCE_CONNECTION Else 'Hyp1 = " "" " + Hyp1 + " "" " On Error Resume Next Err.Clear If Len(Dir(Hyp1)) > 0 Then ' verify path If Err.Number = 52 Then 'Error thrown due to lack of directory access bNoRights = True Else ExistPath = True End If Else If Len(Dir(Hyp1, vbDirectory)) > 0 Then ' verify the file If Err.Number = 52 Then 'Error thrown due to lack of directory access bNoRights = True Else ExistPath = True End If End If End If If ExistPath Then With ActiveCell.Characters(Start1, End1).Font ' Turn line blue if valid .Color = RGB(0, 0, 255) End With Debug.Print "Valid" ActiveWorkbook.FollowHyperlink Address:=Hyp1, NewWindow:=True Else If bNoRights Then With ActiveCell.Characters(Start1, End1).Font ' Turn line green if no access to folder .Color = RGB(0, 255, 0) End With Debug.Print "No Permissions" Else With ActiveCell.Characters(Start1, End1).Font ' Turn line red if not valid .Color = RGB(255, 0, 0) End With Debug.Print "Not Valid" End If End If Err_Trap: If Err <> 0 Then Err.Clear Resume Next End If End If End Sub Sub Nav_Hyp2_Link_Checks() 'On Error Resume Next Range("MultiLink").Select With Selection.Font .ColorIndex = xlAutomatic .TintAndShade = 0 End With 'splits Text active cell using ALT+10 char as separator Dim splitVals As Variant Dim totalVals As Long Dim bNoRights As Boolean splitVals = Split(ActiveCell.Value, Chr(10)) totalVals = UBound(splitVals) Hyp2 = splitVals(1) Hyp3 = splitVals(2) 'Get Line 2 Range Start2 = InStr(Range("MultiLink").Value, Hyp2) End2 = InStr(Range("MultiLink").Value, Hyp3) - 2 '*********************************************************************** ' Hyperlink Validation - Check multilink line in single cell '*********************************************************************** ExistPath = False If Left(Hyp2, 7) = "http://" Or Left(Hyp2, 8) = "https://" Or Left(Hyp2, 6) = "ftp://" Or Left(Hyp2, 7) = "ftps://" Then ExistPath = InternetCheckConnection(Hyp2, 1, 0) '1=FLAG_ICC_FORCE_CONNECTION If ExistPath = 0 Then With ActiveCell.Characters(Start2, End2).Font ' Turn line red if not valid .Color = RGB(255, 0, 0) End With Exit Sub Else With ActiveCell.Characters(Start2, End2).Font ' Turn line blue if valid .Color = RGB(0, 0, 255) End With ActiveWorkbook.FollowHyperlink Address:=Hyp2, NewWindow:=True Exit Sub End If Else On Error Resume Next Err.Clear If Len(Dir(Hyp2)) > 0 Then ' verify path If Err.Number = 52 Then 'Error thrown due to lack of directory access bNoRights = True Else ExistPath = True End If Else If Len(Dir(Hyp2, vbDirectory)) > 0 Then ' verify the file If Err.Number = 52 Then 'Error thrown due to lack of directory access bNoRights = True Else ExistPath = True End If End If End If If ExistPath Then With ActiveCell.Characters(Start2, End2).Font ' Turn line blue if valid .Color = RGB(0, 0, 255) End With Debug.Print "Valid" ActiveWorkbook.FollowHyperlink Address:=Hyp2, NewWindow:=True Else If bNoRights Then With ActiveCell.Characters(Start2, End2).Font ' Turn line green if no access to folder .Color = RGB(0, 255, 0) End With Debug.Print "No Permissions" Else With ActiveCell.Characters(Start2, End2).Font ' Turn line red if not valid .Color = RGB(255, 0, 0) End With Debug.Print "Not Valid" End If End If Err_Trap: If Err <> 0 Then Err.Clear Resume Next End If End If End Sub
Last edited by GaryA; 2012-05-04 at 01:05 AM.
Hi Gary,
Can you upload a new version of the file? I'm a bit lost in all the changes here. I tried adding the last post's routines to the prior file, but it was misisng something for me.
Thanks,
Ken Puls, FCPA, FCMA, MS MVP
Learn to Master Your Data at the Power Query Academy (the world's most comprehensive online Power Query training), with my book M is for Data Monkey, or our new Power Query Recipe cards!
Main Site: http://www.excelguru.ca -||- Blog: http://www.excelguru.ca/blog -||- Forums: http://www.excelguru.ca/forums
Check out the Excelguru Facebook Fan Page -||- Follow Me on Twitter
If you've been given VBA code (a macro) for your solution, but don't know where to put it, CLICK HERE.
Bookmarks