Extract hyperlink target from a cell in different workbook - vba

I have a workbook with a custom right click function that extracts cell values from another workbook depending on what the user chooses. It works very well, I just take in the cell's value from the other workbook. Some cells contain hyperlinks though, and I'd like to import the functional hyperlink, not the value of what's shown in the cell. For example, the following image contains a hyperlink in cell (Y216) of sheet BOS of the input workbook.:
This is an image of the cell I want to copy. It is indeed a hyperlink.
?application.Workbooks(2).Sheets("BOS").Range("Y216").value
returns MKB 70-203 Wicket Shear Pin Detection System, which is indeed correct.
But how do I take the hyperlink's destination? I tried several things including
?application.Workbooks(2).Sheets("BOS").Range("Y216").Hyperlinks.count
returns 0 even though you can see in the image that the hyperlink does have an address. In the same fashion the following sub doesn't enter the For Each because it counts 0 hyperlinks.
Sub HLtester()
Dim HL As Hyperlink
For Each HL In Application.Workbooks(2).Sheets("BOS").Range("Y216").Hyperlinks
Debug.Print HL.Address
Next
End Sub
Expected output would be the link's target J:\SOUM\3191.... as shown in image.
EDIT
If it's important the cell's formula is
=LIEN_HYPERTEXTE("J:\SOUM\3191 M - Old Hickory Dam\11_BOS_FT\02_FT_MECT\21-200 Headcover";"21-200 Headcover")
That's the =HYPERLINK function of French Excel, by the way. I guess in last resort I can take the formula and cut off the function parts to retrieve the link part?

Your command works for me, I don't know why you set the range if you want to loop through all the hyperlinks in the sheet -neither why you set as application. workbooks-, anyways, this worked fine for me:
Sub HLtester()
Dim HL As Hyperlink
For Each HL In Sheets("Sheet1").UsedRange.Hyperlinks
Debug.Print HL.Address
Next
End Sub
You may get it as well within range methods with the following
ActiveCell.Hyperlinks(1).Address
You may get more info here
Edit:
Probably the count is wrong because of the "application.workbook", try to declare it as a variable instead of using it all over the code
Sub HLtester()
Dim HL As Hyperlink
Dim WBAnalyzed As Workbook: Set WBAnalyzed = Workbooks("MyWB.xlsm")
For Each HL In WBAnalyzed.Sheets("Sheet1").UsedRange.Hyperlinks
Debug.Print HL.Address
Next
End Sub
Edit 2:
This is the approach suggested when the hyperlink it's given by its formula
Sub test()
On Error Resume Next 'means no formula
x = Evaluate(Range("A1").Formula)
x1 = Sheets("Sheet1").UsedRange.Hyperlinks.Count
Debug.Print x
Debug.Print x1
End Sub
PS: I saved my variable declaration -just cause-, but, you should always have a neat control for them and use option explicit at the beginning of the module.

Related

How to assign a selected chart name to a cell (not the other way around)?

I'm still a beginner with VBA and I'm learning a ton from stackoverflow and from general googling.
I'm hitting a wall on this very general task : I'm trying to show a text giving a very general explanation of a chart when it is selected / hovered-over.
The way I was thinking of approaching this was to create a tab with all my chart names (which I already have for other tasks) and create a little text for each of them. A cell (the VBA part) would contain the selected chart name that I could use to do a simple vlookup to fetch the explanation.
I tried to look on google how to do this and I'm usually pretty successful with forums and such, but there are sooooo many information on how to name a chart name based on a cell that I can't seem to find information on how to name a cell based on a chart name.
Edit : was cut off while typing by my newborn waking up, my bad completely forgot to come back and add my attempted code !!!
Sub Test_Chart_Name()
Dim T As String
T = ActiveChart.ChartTitle.Text
Range("AM41").Value = T
End Sub
So far it works when I run it, I do believe I should be able to make it run automatically whenever I select a new chart but right now the wrong behavior is that it display the chart title instead of the name I assigned to it (ie it paste 'Pay per month in dollars' instead of 'Monthly_pay'.
Here's how I approached the request. I wrote a macro that looks up the description of the chart, and displays it in a message box. For each chart you want to run it with, right click the chart, click Assign Macro from the pop-up menu, and select the macro. When you click on the chart, the macro runs. You can also run the macro anytime from Developer tab > Macros or the shortcut Alt+F8.
I set up a lookup range on the active sheet (it could be anywhere) with chart names in the first column and descriptions in the second.
Sub PopUpChartDescription()
Dim rTable As Range, rCell As Range
Dim sName As String, sDescription As String, sCaller As String
On Error Resume Next
sCaller = Application.Caller
If Len(sCaller) > 0 Then ' macro called by clicking on a chart
' activate the chart or it is deactivated after the macro runs
ActiveSheet.ChartObjects(sCaller).Activate
DoEvents
DoEvents
End If
On Error GoTo 0
If Not ActiveChart Is Nothing Then ' so ActiveChart is something, eh?
sName = ActiveChart.Parent.Name
Set rTable = ActiveSheet.Range("DisplayTable") ' my lookup range
Set rCell = rTable.Columns(1).Find(What:=sName) ' find the chart name
If Not rCell Is Nothing Then ' so rCell containing chart name was found
sDescription = rCell.Offset(, 1).Text
' show the description
MsgBox sDescription, vbInformation, "Chart Description"
End If
End If
End Sub
You could try the code below:
Sub Test_Chart_Name()
Dim T As String
T = ActiveChart.Parent.Name
Range("AM41").Value = T
End Sub
Hope that helps!

Excel VBA: How do I delete images in a specific range

I have a macro that imports data from a selected file. The data includes some images. The problem I am having is if i have data and images already in my document, and I go to import new data, the images do not delete and simply get pasted on top of each other. I wrote code to select the cells and clear them, but it doesn't clear the images.
I think the solution is to put some code at the beginning that can select the images in the cell range and delete them, before the new data is imported.
I came across a solution that Selects all images in the worksheet and deletes them, But I have other images that I need to keep.
Is is possible to tell it to select all images in a specific range of cells?
A quick Google search (most questions have been asked in one place or another) came up with this result. It uses the TopLeftCell and BottomRightCell attributes of Excel Picture objects, then checks if it is inside the range.
Sub test()
'Code by Peter T from https://www.excelbanter.com/excel-programming/404480-select-delete-all-pictures-given-range.html
Dim s As String
Dim pic As Picture
Dim rng As Range
' Set ws = ActiveSheet
Set ws = ActiveWorkbook.Worksheets("Sheet2")
Set rng = ws.Range("A5:C25")
For Each pic In ActiveSheet.Pictures
With pic
s = .TopLeftCell.Address & ":" & .BottomRightCell.Address
End With
If Not Intersect(rng, ws.Range(s)) Is Nothing Then
pic.Delete
End If
Next
End Sub
I have not tested this code, but even so it should provide you with enough information to adjust your own code.
Thanks. I too came across this but was having issues with it. With more research, I was able to get this code to do what I wanted it to,
Sub DeleteImage()
Dim pic As Picture
ActiveSheet.Unprotect
For Each pic In ActiveSheet.Pictures
If Not Application.Intersect(pic.TopLeftCell, range("H10:R24")) Is Nothing Then
pic.Delete
End If
Next pic
End Sub

Hyperlink directs to hidden row

I have a workbook that has 2 sheets. Sheet 1 has hyperlinks to several different cells in Sheet 2. The issue is that there are filters in Sheet 2 that will hide rows, so when you try to follow the hyperlink from Sheet 1, the row is hidden and you can't see the target. I'm trying to figure out how to do the following:
On clicking a hyperlink, determine the target row in Sheet 2
If target row is hidden, unhide the target row in sheet 2, then follow the hyperlink.
It can stay unhidden after the hyperlink is followed, I'm fine with that. I've struggled with this for the past several days, and have come up with nothing successful. I've tried the "Followhyperlink" function, but I think this is too late - it's already followed the hyperlink, so unhiding the row at that point is too late.
Any suggestions? I'm stumped!
FollowHyperlink is indeed the event handler to use. Put this code in the worksheet module for Sheet1:
Option Explicit
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
Dim hyperlinkParts() As String
If ((Target.Type = msoHyperlinkRange) And (Target.SubAddress <> "")) Then
If (InStr(Target.SubAddress, "!") > 0) Then
hyperlinkParts = Split(Target.SubAddress, "!")
If ((Left$(hyperlinkParts(0), 1) = "'") And (Right$(hyperlinkParts(0), 1) = "'")) Then
hyperlinkParts(0) = Mid$(hyperlinkParts(0), 2, Len(hyperlinkParts(0)) - 2)
End If
Worksheets(hyperlinkParts(0)).Range(hyperlinkParts(1)).EntireRow.Hidden = False
End If
End If
End Sub
This checks that the hyperlink corresponds to a Range object then splits the target address into the sheet name and the specific cell(s). It then unhides the row(s) which correspond to the target address.
The check for the subaddress being empty is needed for hyperlinks to an external workbook where no particular cell is specified
edit: this approach won't work for hyperlinks to named ranges and I've altered the code to avoid getting an error message with that kind of hyperlink
edit2; code revised to deal with worksheet names containing spaces which were previously causing an error

Excel macro select two ranges and compare

This is a question that was asked to me in an interview. I have a excel list. It is copied to another location and then by mistake a row in the new location gets deleted.
Now I need to write a macro to compare the old and new ranges and then provide the missing data as result.
I can perhaps perform the comparison part. But the problem is I don't know how to get the selected range as input in a macro.
For eg. as soon as I select a range, it should be sent as input to the macro, then the macro should wait for another selection. As soon as I select the new range, the macro should compare and find the missing lines in new range.
Regarding the selection per mouse click you could look at the link I sent in the comments of the other answer. Selection_Change is an event which gets triggered when you change the selection of a worksheet (not only mouseclick but move-by-keys as well). The target coming in is the cell which you have selected. You can pass this as a range on to a function.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
showMsg Target
End Sub
Private Function showMsg(r As Range)
MsgBox r.Address
End Function
You can just as well use another event like BeforeDoubleClick or BeforeRightClick. Check out the events of Excel and choose the one you feel fits best.
If you only want the function to be triggered for a certain range you can filter it.
If target.column <> 1 then exit function
If you don't want the event to trigger your function each time you change a selection you can choose one cell to be the switch which gets triggered by the same event.
If target.address = "$A$1" Then Call toggleSearch()
with toggleSearch being the switching function.
This is a classical diff (and a simple one at that), you shouldn't select by hand or anything. Just sort the two lists in an identical way, then run a Sub which loops over the number of rows in the source sheet comparing each row with the same row in the target sheet. The first mismatch you get is the missing line.
This example assumes both sheets are in the same workbook but you can easily adapt it
Public Sub diffThem()
Dim src as Worksheet, trg as Worksheet
Dim r as Range, i as Integer
Set src = ThisWorkbook.Sheets("Source")
Set trg = ThisWorkbook.Sheets("Destination")
Set r = src.Range("A1")
For i = 1 to ThisWorkbook.Sheets("Source").UsedRange.Rows.Count
If r.EntireRow <> trg.Range("A" & r.Row).EntireRow Then
MsgBox("The missing row is " & r.Row)
Exit Sub
End if
Set r = r.Offset(1,0)
Next i
End Sub
If EntireRow cannot be run due to different layouts or whatever then loop the columns at that point.

Get the cell reference of the value found by Excel INDEX function

The Problem
Assume that the active cell contains a formula based on the INDEX function:
=INDEX(myrange, x,y)
I would like to build a macro that locates the value found value by INDEX and moves the focus there, that is a macro changing the active cell to:
Range("myrange").Cells(x,y)
Doing the job without macros (slow but it works)
Apart from trivially moving the selection to myrange and manually counting x rows y and columns, one can:
Copy and paste the formula in another cell as follows:
=CELL("address", INDEX(myrange, x,y))
(that shows the address of the cell matched by INDEX).
Copy the result of the formula above.
Hit F5, Ctrl-V, Enter (paste the copied address in the GoTo dialog).
You are now located on the very cell found by the INDEX function.
Now the challenge is to automate these steps (or similar ones) with a macro.
Tentative macros (not working)
Tentative 1
WorksheetFunction.CELL("address", ActiveCell.Formula)
It doesn't work since CELL for some reason is not part of the members of WorksheetFunction.
Tentative 2
This method involves parsing the INDEX-formula.
Sub GoToIndex()
Dim form As String, rng As String, row As String, col As String
form = ActiveCell.Formula
form = Split(form, "(")(1)
rng = Split(form, ",")(0)
row = Split(form, ",")(1)
col = Split(Split(form, ",")(2), ")")(0)
Range(rng).Cells(row, CInt(col)).Select
End Sub
This method actually works, but only for a simple case, where the main INDEX-formula has no nested subformulas.
Note
Obviously in a real case myrange, x and ycan be both simple values, such as =INDEX(A1:D10, 1,1), or values returned from complex expressions. Typically x, y are the results of a MATCH function.
EDIT
It was discovered that some solutions do not work when myrange is located on a sheet different from that hosting =INDEX(myrange ...).
They are common practice in financial reporting, where some sheets have the main statements whose entries are recalled from others via an INDEX+MATCH formula.
Unfortunately it is just when the found value is located on a "far" report out of sight that you need more the jump-to-the-cell function.
The task could be done in one line much simpler than any other method:
Sub GoToIndex()
Application.Evaluate(ActiveCell.Formula).Select
End Sub
Application.Evaluate(ActiveCell.Formula) returns a range object from which the CELL function gets properties when called from sheets.
EDIT
For navigating from another sheet you should first activate the target sheet:
Option Explicit
Sub GoToIndex()
Dim r As Range
Set r = Application.Evaluate(ActiveCell.Formula)
r.Worksheet.Activate
r.Select
End Sub
Add error handling for a general case:
Option Explicit
Sub GoToIndex()
Dim r As Range
On Error Resume Next ' errors off
Set r = Application.Evaluate(ActiveCell.Formula) ' will work only if the result is a range
On Error GoTo 0 ' errors on
If Not (r Is Nothing) Then
r.Worksheet.Activate
r.Select
End If
End Sub
There are several approaches to select the cell that a formula refers to...
Assume the active cell contains: =INDEX(myrange,x,y).
From the Worksheet, you could try any of these:
Copy the formula from the formula bar and paste into the name box (to the left of the formula bar)
Define the formula as a name, say A. Then type A into the Goto box or (name box)
Insert hyperlink > Existing File or Web page > Address: #INDEX(myrange,x,y)
Adapt the formula to make it a hyperlink: =HYPERLINK("#INDEX(myrange,x,y)")
Or from the VBA editor, either of these should do the trick:
Application.Goto Activecell.FormulaR1C1
Range(Activecell.Formula).Select
Additional Note:
If the cell contains a formula that refers to relative references such as =INDEX(A:A,ROW(),1) the last of these would need some tweaking. (Also see: Excel Evaluate formula error). To allow for this you could try:
Range(Evaluate("cell(""address""," & Mid(ActiveCell.Formula, 2) & ")")).Select
This problem doesn't seem to occur with R1C1 references used in Application.Goto or:
ThisWorkbook.FollowHyperlink "#" & mid(ActiveCell.FormulaR1C1,2)
You could use the MATCH() worksheet function or the VBA FIND() method.
EDIT#1
As you correctly pointed out, INDEX will return a value that may appear many times within the range, but INDEX will always return a value from some fixed spot, say
=INDEX(A1:K100,3,7)
will always give the value in cell G3 so the address is "builtin" to the formula
If, however, we have something like:
=INDEX(A1:K100,Z100,Z101)
Then we would require a macro to parse the formula and evaluate the arguments.
Both #lori_m and #V.B. gave brilliant solutions in their own way almost in parallel.
Very difficult for me to choose the closing answer, but V.B. even created Dropbox test file, so...
Here I just steal the best from parts from them.
'Move to cell found by Index()
Sub GoToIndex()
On Error GoTo ErrorHandler
Application.Goto ActiveCell.FormulaR1C1 ' will work only if the result is a range
Exit Sub
ErrorHandler:
MsgBox ("Active cell does not evaluate to a range")
End Sub
I associated this "jump" macro with CTRL-j and it works like a charm.
If you use balance sheet like worksheets (where INDEX-formulas, selecting entries from other sheets, are very common), I really suggest you to try it.