Run Excel-Macro with =HYPERLINK-Formula (through Selection_Change event) - excel

I want to find a way to dynamically add hyperlinks to my Excel-Sheet and run macros depending on some cell contents. But neither the HYPERLINK-formula nor the regular hyperlink feature in Excel allow you to call macros directly from the worksheet. Looking for that problem online will always retrieve the option to use the Worksheet_FollowHyperlink event. But for my purpose this option is not suitable as you either have to write your macro to like "if target.range.address = A1 call macroA elseif target.cell = A2 call macro ...." etc... This solution is way too static in my opinion as you have to "hardwire" too much in your Worksheet_FollowHyperlink code. Furthermore you have to prepare the hyperlinks via VBA to change the address and subaddress to "" to avoid unwanted selection changes or error popups from excel (because some adress could not be found).
The =HYPERLINK()-formula looks way more interesting since you can dynamically create it wherever and whenever needed. It also works fine as a column-function inside a table which is what I actually want to do: Have a column filled with hyperlinks inside a table that will run macros with some given parameters depending on the other contents in each table data row. This would not work with regular hyperlinks at all as the user has to copy & paste them manually into every single row.
Sadly the =HYPERLINK()-formula also offers no option to run a macro directly with the given parameters (at least none that I could find). It will not even fire the Worksheet_FollowHyperlink event so it appears to be a dead end at this point.
Interesting feature I found during my trial and error + internet research:
=HYPERLINK("#TestMe", "Some text here...") will open the VBA-editor and jump directly to my TestMe() sub. Yet it will not be called!
What could be the solution to this problem?
Create Hyperlinks dynamically in a table data column
Call a macro depending on the data row contents

I had the idea to use the Workbook_SheetSelectionChange event to monitor if a cell with a HYPERLINK-formula was selected and it turned out very well.
First revision of my code:
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim MacroName As String
If Target.Cells.Count > 1 Then Exit Sub
If Target.Formula Like "=HYPERLINK(LEFT(""|""*""|"",*),*)" Then
MacroName = Split(Target.Formula, """|""")(1)
MacroName = VBA.Trim(Replace(MacroName, "&", ""))
MacroName = Sh.Evaluate(MacroName)
Application.Run Macro
End If
End Sub
It requires to have a cell with the following formula:
=HYPERLINK(LEFT("|" & A1 & "|", 0), "Run Macro in A18") where cell A1 contains the name of some macro I want to run. The name of the macro could also be hardwired in the formula.
Note: the LEFT(..., 0) part is needed so the address of the hyperlink will appear empty to excel when clicking it. Otherwise it will bother you with an error popup for not finding the target.
Unfortunately the SelectionChange event also fires when selecting a cell with return-key, tab-key or arrow keys. To filter these out, you will need the following API-call:
Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vkey As Integer) As Boolean
This function checks if a key is pressed at the moment it gets called.
Source is this unresolved question: How to run code when clicking a cell?
The next evolution of the code above now looks like this:
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If GetAsyncKeyState(vbKeyTab) _
Or GetAsyncKeyState(vbKeyReturn) _
Or GetAsyncKeyState(vbKeyDown) _
Or GetAsyncKeyState(vbKeyUp) _
Or GetAsyncKeyState(vbKeyLeft) _
Or GetAsyncKeyState(vbKeyRight) _
Or Target.Cells.Count > 1 _
Or VBA.TypeName(Sh) <> "Worksheet" _
Then Exit Sub
Dim Macro As String
If Target.Formula Like "=HYPERLINK(LEFT(""|""*""|"",*),*)" Then
Macro = Split(Target.Formula, """|""")(1)
Macro = VBA.Trim(Replace(Macro, "&", ""))
Macro = Sh.Evaluate(Macro)
Application.Run Macro
End If
End Sub
This now will filter out all selection changes done by key commands.
Yet there is one more step to take as I had to notice there seems to be a flaw when changing a cell above or left of my hyperlink and hit return key or tab key. For some reason the GetAsyncKeyState will return false for both keys so my code would continue to run.
So for these situations I had to create a little dirty work around. You will need the Workbook_SheetChange event to set a switch which temporarily disables the Workbook_SheetSelectionChange event.
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
RecentSheetChange = True
Application.OnTime VBA.DateAdd("s", 0.1, Now), "ResetRecentSheetChange"
End Sub
'Code inside a new module:
Option Explicit
Option Private Module
Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vkey As Integer) As Boolean
Public RecentSheetChange As Boolean
Private Sub ResetRecentSheetChange()
RecentSheetChange = False
End Sub
The final code in ThisWorkbook now looks like this:
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If GetAsyncKeyState(vbKeyTab) _
Or GetAsyncKeyState(vbKeyReturn) _
Or GetAsyncKeyState(vbKeyDown) _
Or GetAsyncKeyState(vbKeyUp) _
Or GetAsyncKeyState(vbKeyLeft) _
Or GetAsyncKeyState(vbKeyRight) _
Or Target.Cells.Count > 1 _
Or VBA.TypeName(Sh) <> "Worksheet" _
Or RecentSheetChange _
Then Exit Sub
Dim Macro As String
If Target.Formula Like "=HYPERLINK(LEFT(""|""*""|"",*),*)" Then
Macro = Split(Target.Formula, """|""")(1)
Macro = VBA.Trim(Replace(Macro, "&", ""))
Macro = Sh.Evaluate(Macro)
Application.Run Macro
End If
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
RecentSheetChange = True
Application.OnTime VBA.DateAdd("s", 0.1, Now), "ResetRecentSheetChange"
End Sub
Adding parameter features to the hyperlink is only a small step from here.
Your thoughts?

Related

Running script when a specific cell in another workbook changes

Trying to create a script which detects when cell B2" in another workbook changes.
Once the change is detected run the macro RUNALL which has already been created and is working. RUNALL will run a number of macros, which saves as a pdf and sends an email to the customer.
Sub Worksheet_Changes(ByVal Target As Range)
' Run the code when cell B2 is changed
If Target.Address = Workbook("M:\Wholesale\Test.xlsx").Sheet("Sheet1").Range("B2").Address Then
Call RUNALL
End If
End Sub
Read up on Application events: https://learn.microsoft.com/en-us/office/troubleshoot/excel/create-application-level-event-handler
In a class module clsAppEvents:
Option Explicit
Private WithEvents app As Excel.Application
Private cellToMonitor As Range
Private Sub app_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Sh.Parent.Name = cellToMonitor.Worksheet.Parent.Name Then
If Sh.Name = cellToMonitor.Worksheet.Name Then
If Not Application.Intersect(Target, cellToMonitor) Is Nothing Then
Debug.Print "Changed " & cellToMonitor.Address & " on " & _
Sh.Name & " in " & Sh.Parent.Name
End If
End If
End If
End Sub
Private Sub Class_Initialize()
Set app = Application
End Sub
Property Set TheCell(c As Range)
Set cellToMonitor = c
End Property
In a regular module:
Option Explicit
Private obj
Sub Tester()
Set obj = New clsAppEvts
Set obj.TheCell = Workbooks("Book2").Sheets(1).Range("A3") 'for example
End Sub
As BigBen has pointed out, the Worksheet_Changes is triggered only when there is a change in the sheet where your script is specifically located, therefore you should move the macro to the sheet's code located on the other workbook (the one that suffers the change).
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$2" Then
Application.Run ("'M:\Wholesale\My_Book.xlsm'!RUNALL")
End If
End Sub
Since the RUNALL macro will be located in a different workbook, you should use the Application.Run() method as findwindow also pointed out to make the reference to a different workbook. In this case "My_book.xlsm" is the one containing the RUNALL macro.
Moreover, note that Workbook("M:\Wholesale\Test.xlsx").Sheet("Sheet1").Range("B2").Address will only return $B$2 making no difference between the two workbooks.

Issue with TAB event in Excel VBA

When user click TAB key from keyboard, some cells should be updated in the same row(Event should be happen iff there is some data in that cell). As of know I written some sample code to display some message. I written code inside the workbook as below
Private Sub Workbook_SheetselectionChange (ByVal Sh As Object, ByVal Target As Range)
Application.EnableEvents = True
Application.OnKey"{TAB}", "sayHi"
End Sub
Sub sayHi()
Application.EnableEvents = True
MsgBox "Hiiii"
End Sub
Issue :- whenever I am clicking TAB key, getting one warning like "cannot run the macro 'C:...sayHi'. The macro may not be available in this workbook or all macros may be disabled".

Changes of tab color - macro - does not work properly

I have a macro which changes the tab colors. If there is any value in the sheet then the tab changes into green. If there is nothing then it changes into red. I combined this macro from the ready ones found on the internet. Currently I put this to ThisWorkbook but in this instance it applies to every sheet in the workbook and I wanted only those 2 sheets specified by me ("Our Data" and "Test"). I split this macro to sheets located above ThisWorkbook but then it doesn't work. Can somebody help me to amend it?
Private Sub Workbook_SheetChange(ByVal Test As Object, ByVal Target As Range)
If Cells.Find("*") Is Nothing Then
Test.Tab.ColorIndex = 3
Else
Test.Tab.ColorIndex = 10
End If
End Sub
Private Sub Workbook_SheetChange2(ByVal Test As Object, ByVal Target As Range)
If Cells.Find("*") Is Nothing Then
Our Data.Tab.ColorIndex = 3
Else
Our Data.Tab.ColorIndex = 10
End If
End Sub
You can't split it this way... Delete the second one and improve first as presented below:
Private Sub Workbook_SheetChange(ByVal Test As Object, ByVal Target As Range)
If Test.Name = "Our Data" Or Test.Name = "Test" Then
If Cells.Find("*") Is Nothing Then
Test.Tab.ColorIndex = 3
Else
Test.Tab.ColorIndex = 10
End If
End Sub
Keep it where you have it now (in ThisWorkbook module)
EDIT- additional information for all who will want to use it. Presented idea is very inefficient. The event will fire each time when any changes would be made in any of cell in any of sheet. Please consider using other events. I would suggest to use SheetActivate of SheetDeactivate.

How can I automatically convert a field in lowercase to uppercase in Excel?

I have produced some VBA code to resolve this problem :
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Value <> Empty Then
Target.Value = UCase(Target.Value)
End If
End Sub
But when I try to input some data in a field, Excel stops working without a single error message.
Does anyone know where this problem can come from ?
You probably have set Application.EnableEvents = False. Open the Immediate window in the VBA editor and type in application.EnableEvents = True then ENTER to turn them back on.
Also, you need to disable events if you don't want to cause a cycle of changing the sheet and re-triggering the event. The ISEMPTY function is slightly different in VBA and your code could be updated to the following which will also handle changing more than just 1 cell
Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim cell As Variant
Application.EnableEvents = False
For Each cell In Target
If Not IsEmpty(cell.Value) Then
cell.Value = UCase(cell.Value)
End If
Next cell
Application.EnableEvents = True
End Sub
or if you want to restrict this running to 1 cell change only, replace the for each loop with If Target.rows.count = 1 AND Target.columns.count = 1....
You may not have the callback function in the right spot:
From Events And Event Procedures In VBA
For sheet (both worksheet and chart sheet) level events, the event procedure code must be placed in the Sheet module associated with that sheet. Workbook level events must be placed in the ThisWorkbook code module. If an event procedure is not in the proper module, VBA will not be able to find it and the event code will not be executed.

Cannot VBA write data to cells in Excel 2007/2010 within a function

I want to set value for cells by VBA. I have googled, and see some resolution:
Sheets("SheetName").Range("A1").value = someValue
Sheets("SheetName").Cells(1,1).value = someValue
With this kind of code, I can just read data from cell A1 but I cannot set a new value to it.
Update
The code to set cell A1 value is put within a Function as below.
Function abb()
Sheets("SheetName").Range("A1").value = 122333
abb = 'any thing'
End Function
In cell B2, I set =abb() and hit enter. I get #VALUE but nothing happen at A1.
Putting this code in a macro, it works.
My question is, how to make A1 have values within a function?
From your comment above you wanted to try this approach
If you enter
=abb()
into any cell
Then cell A1 of that sheet wil be set to 12333
This is the line to update to pick the cell to update, and to place a value in it
Range("A1").Value = 122333
From I don't want my Excel Add-In to return an array (instead I need a UDF to change other cells)
I am reposting this piece of magic from Kevin Jones aka Zorvek as it sits behind the EE Paywall (link attached if anyone has access)
While Excel strictly forbids a UDF from changing any cell, worksheet,
or workbook properties, there is a way to effect such changes when a
UDF is called using a Windows timer and an Application.OnTime timer in
sequence. The Windows timer has to be used within the UDF because
Excel ignores any Application.OnTime calls inside a UDF. But, because
the Windows timer has limitations (Excel will instantly quit if a
Windows timer tries to run VBA code if a cell is being edited or a
dialog is open), it is used only to schedule an Application.OnTime
timer, a safe timer which Excel only allows to be fired if a cell is
not being edited and no dialogs are open.
The example code below illustrates how to start a Windows timer from
inside a UDF, how to use that timer routine to start an
Application.OnTime timer, and how to pass information known only to
the UDF to subsequent timer-executed routines. The code below must be
placed in a regular module.
Declare Function SetTimer Lib "user32" ( _
ByVal HWnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long _
) As Long
Private Declare Function KillTimer Lib "user32" ( _
ByVal HWnd As Long, _
ByVal nIDEvent As Long _
) As Long
Private mCalculatedCells As Collection
Private mWindowsTimerID As Long
Private mApplicationTimerTime As Date
Public Function abb()
' This is a UDF that returns the sum of two numbers and starts a windows timer
' that starts a second Appliction.OnTime timer that performs activities not
' allowed in a UDF. Do not make this UDF volatile, pass any volatile functions
' to it, or pass any cells containing volatile formulas/functions or
' uncontrolled looping will start.
abb = "Whatever you want"
' Cache the caller's reference so it can be dealt with in a non-UDF routine
If mCalculatedCells Is Nothing Then Set mCalculatedCells = New Collection
On Error Resume Next
mCalculatedCells.Add Application.Caller, Application.Caller.Address
On Error GoTo 0
' Setting/resetting the timer should be the last action taken in the UDF
If mWindowsTimerID <> 0 Then KillTimer 0&, mWindowsTimerID
mWindowsTimerID = SetTimer(0&, 0&, 1, AddressOf AfterUDFRoutine1)
End Function
Public Sub AfterUDFRoutine1()
' This is the first of two timer routines. This one is called by the Windows
' timer. Since a Windows timer cannot run code if a cell is being edited or a
' dialog is open this routine schedules a second safe timer using
' Application.OnTime which is ignored in a UDF.
' Stop the Windows timer
On Error Resume Next
KillTimer 0&, mWindowsTimerID
On Error GoTo 0
mWindowsTimerID = 0
' Cancel any previous OnTime timers
If mApplicationTimerTime <> 0 Then
On Error Resume Next
Application.OnTime mApplicationTimerTime, "AfterUDFRoutine2", , False
On Error GoTo 0
End If
' Schedule timer
mApplicationTimerTime = Now
Application.OnTime mApplicationTimerTime, "AfterUDFRoutine2"
End Sub
Public Sub AfterUDFRoutine2()
' This is the second of two timer routines. Because this timer routine is
' triggered by Application.OnTime it is safe, i.e., Excel will not allow the
' timer to fire unless the environment is safe (no open model dialogs or cell
' being edited).
Dim Cell As Range
' Do tasks not allowed in a UDF...
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Do While mCalculatedCells.Count > 0
Set Cell = mCalculatedCells(1)
mCalculatedCells.Remove 1
Range("A1").Value = 122333
Loop
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
You cannot change cell A1 with a function in B2.
Visit: Description of limitations of custom functions in Excel
. The text includes:
"A user-defined function called by a formula in a worksheet cell cannot change the environment of Microsoft Excel. This means that such a function cannot do any of the following:
Insert, delete, or format cells on the spreadsheet.
Change another cell's value. [My highlighting]
Move, rename, delete, or add sheets to a workbook.
Change any of the environment options, such as calculation mode or screen views.
Add names to a workbook.
Set properties or execute most methods."
Why do you want to change cell A1 in this way? Explain your objective and perhaps someone can help.
If you want to modify two cells with one formula, you may want to consider returning an array from your function. Here's an example:
Function abb()
Dim arr As Variant
ReDim arr(1 To 2)
arr(1) = "aardvark"
arr(2) = "bee"
abb = arr
End Function
Select cells A2 to B2. Type =abb() and press ShiftCtrlEnter to specify that it is an array formula. This formula then modifies both cells (A2 and B2) at the same time.
Perhaps you can customise this to do what you want.
it should work - try this
Open a new excel sheet
Create a new macro
Add this Sheets("Sheet1").Range("A1").Value2 = "value"
you can use both .Value and .Value2, make sure that the sheet name is correct.

Resources