Control double click event for row header - excel

So I'm pretty familiar with referencing worksheet ranges for worksheet events such as double click. In this case though, I'm looking to reference when the row header gets double clicked instead of a cell. It would still be specific to a worksheet but I've been unsuccessful thus far.
I have multiple ranges that do different events on double clicks so I use code similar to the example below:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim rWatchRange As Range
Dim sWatchRange As Range
Set rWatchRange = Range("A5:A1000")
'I somehow need it to recognize if the row header is
'double clicked between row 5 and 1000 to fire off the second sub
Set sWatchRange = Range("5:1000")
If Not Application.Intersect(Target, rWatchRange) Is Nothing Then
Run "aFormattingSub"
End If
If Not Application.Intersect(Target, sWatchRange) Is Nothing Then
Run "aSubToInsertNewLineAndGroupWithRowAbove"
End If
End Sub
I'm not sure if there is a worksheet reference, application reference or a setting in Excel that I'm aware of that can do this.

The DoubleClick Event does not fire when the headers are doubleclicked. I don't think there is any trivial way around this - you have to live with the events as they are provided.
I think there are still enough room to implement more functionality.
To give you some more ideas, you could do different things on a double click or right click with ctrl held down.
An example that reacts to the right click with ctrl held down, and only when entire rows are selected:
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If (GetKeyState(KeyCodeConstants.vbKeyControl) And &H8000) And _
Selection.Address = Selection.EntireRow.Address Then
Cancel = True
' ... code
End If
End Sub
(the And &H8000 is necessary to react only to currently present and ignore previous keypresses)
Import the API function in a module:
Public Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer

Related

How can I establish a Range of cells within a Worksheet to which the following code applies? As currently written it applies to the entire Worksheet [duplicate]

I'm looking for the best way to code in multiple ranges for my double click event.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("A3:A25")) Is Nothing Then
'code
End If
End Sub
As you see above, when A3 to A25 is clicked, the double click event takes place. But I also have other sections throughout the sheet that I want to include to set off the event. A29:A40, F3:F37, K3:K40, P3:P40.
What is the best way to code that without adding new 'If' blocks?
Or is adding the new 'If' blocks (and calling a subroutine) the best way?
Use this one:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("A3:A25, A29:A40, F3:F37, K3:K40, P3:P40")) Is Nothing Then
'code
End If
End Sub

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

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?

Antecedent ActiveCell.Address

I am new at vba and I have a rather simple issue. I want to obtain the address of the last active cell there was. For example, if I was at A5 and moved to B6, is there a command to obtain the address A5?
Any type of tip or suggestion is highly appreciated!
I've tried ActiveCell.Previous but that provides the address of the cell on the left of the active cell. Offsets are no use for me since the address A5 is unknown until the user changes something inside a grid of cells.
The most obvious way would be to use Excel's events. You could have a look at the SelectionChange event, which would enable you to store the previous selection at module-level and then retrieve that value on subsequent firings of the event.
In the example below I've used the code-behind of the Workbook object, as it enables you to register selections on any sheet, but you could do the same on just one Worksheet.
If you're only interested in certain cells, then look at the Intersect function to refine the routine.
Option Explicit
Private pPreviousWorksheet As Worksheet
Private pPreviousSelection As Range
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
'Check SH object is a worksheet.
If TypeOf Sh Is Worksheet Then
'Check we have instances of previous objects.
If Not pPreviousWorksheet Is Nothing And Not pPreviousSelection Is Nothing Then
'Process code here...
MsgBox "Previous was " & _
pPreviousWorksheet.Name & "!" & _
pPreviousSelection.Address(False, False)
End If
'Re-set the previous objects.
Set pPreviousWorksheet = Sh
Set pPreviousSelection = Target
End If
End Sub

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 to auto-size column-width in Excel during text entry

I usually try to avoid VBA in Excel, but it would be convenient to be able to type text into a cell, and have its column get wider or narrower to accommodate the text remaining as it's entered or deleted.
This would be subject, of course, to the lengths of the text in the other cells in the column.
'Auto-fit as you type', I guess you might call it.
Is there an easy way to do this in a suitable handler?
I'm not sure if there is a way to do it while your typing. I think excel generally stretches the cell view to display all the text before it fires the worksheet_change event.
This code will resize the column after you have changed and moved the target to a new range. Place it in the worksheet module.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim nextTarget As Range
Set nextTarget = Range(Selection.Address) 'store the next range the user selects
Target.Columns.Select 'autofit requires columns to be selected
Target.Columns.AutoFit
nextTarget.Select
End Sub
If your just looking to do it for a particular column you would need to check the target column like this:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim nextTarget As Range
Set nextTarget = Range(Selection.Address) 'store the next range the user selects
If Target.Column = 1 Then
Target.Columns.Select 'autofit requires columns to be selected
Target.Columns.AutoFit
nextTarget.Select
End If
End Sub
I cannot think of a way to do what you ask for but something very close to your need.
In modern versions of Excel (2010+, I don't know about the 2007 version) you could use the following macro to resize your column to fit data as soon you finished entering data in a cell.
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.ScreenUpdating = False
ActiveSheet.Columns.AutoFit
End Sub
Put the macro in ThisWorkbook module
This will automatically fit columns width
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Columns.AutoFit
End Sub
I just tried the previous two answers on a sheet and they didn't do anything, idk if the "ByVal Sh" is the problem?? was it a typo?
Anyhow, here is my answer, checked it and it works:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target Is Nothing Then
Exit Sub
Else
With Target
.Columns.Select
.Columns.AutoFit
End With
End If
End Sub
-.Reverus.

Resources