Start macro by double click for multiple cell range - vba

Im trying to start a macro when someone double-clicks a certain range of cells. The compleet sub I got now is:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, cancel As Boolean)
If Not Application.Intersect(Target, Range("F5")) Is Nothing Then
cancel = True
Dim GoogleMapsCheckLink As String
GoogleMapsCheckLink = "https://www.google.nl/maps/place/" + Range("F5").Value + " " + Range("F6").Value + " " + Range("F7").Value
ActiveWorkbook.FollowHyperlink GoogleMapsCheckLink
GoogleMapsCheckYN.Show
End If
If Not Application.Intersect(Target, Range("B52, B61, D52, D61")) Is Nothing Then
cancel = True
macro
End If
End Sub
But whenever I select one of the cells e.g. B52, B61, D52 or D61 I get a compile error with the message:
Compile error:
Wrong number of arguments or invalid property assignment
The word Range is highlighted.
My question is of course what am I doing wrong currently?
EDIT:
After changing Range to
Range("B52, B61, D52, D61")
I get another error:
Run-time error '1004':
Method ' Range' of object'_Worksheet' failed
Btw I also got other macros that are being activated through double clicking a certain cell value and those do work. The error only occurs when I got multiple cells as range...

Worked for me, using Office 2010.
If the Targets are in Sheet1 then make sure the script is in the Sheet1 Module
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Application.Intersect(Target, Range("B52, B61, D52, D61")) Is Nothing Then
Cancel = True
Worked = "Yes"
'Calling Macro would go here
Call SomeModule.SomeMarco
Else
Worked = "No"
End If
MsgBox Worked
End Sub

Change your range like this:
Range("B52, B61, D52, D61")
This is now a valid range reference in Excel. The Range method either accepts two references, and then refers to all the cells in between, or accepts a valid range name.

Related

VBA to update formula when a value changes in a refence range

I have an Excel formula that gives me the last Friday's date "=TODAY()-WEEKDAY(TODAY())-1" in cell A1
I want to update cell A1 only when the values in reference range in another worksheet B2:D469 changes.
Below is the code i am using but the issue is code only works when i manually make a change in the range. However values in the range gets updated when source pivot table refresh. I want code to get updated when i refresh the pivot table and the values in the range "B2:D469" changes.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Set KeyCells = Worksheets.("Source").Range("B2:D469")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
Worksheets.("Dashboard").Range ("A1").EnableCalculation = True
End If
End Sub
Range.Dependents
Range has a property Dependents which is a Range containing all cells that this Range affects, even if they are several steps removed. For example if C4 is "=B4" and B4 is "=A4", Range("A4").Dependents will include both B4 and C4.
So, in your case, if Target affects a cell you care about, it's included in the Range Target.Dependents. You can use this to accomplish your goal.
How to use it
Use the following as the code of ThisWorkbook. I've commented the heck out of it, but if you have questions feel free to ask in the comments.
Option Explicit
Private RangeToMonitor As Range
Private RangeToChange As Range
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'---If this is the first change since the workbook has been opened, define the ranges---
If RangeToMonitor Is Nothing Then
Set RangeToMonitor = Worksheets("Source").Range("B2:D469")
Set RangeToChange = Worksheets("Dashboard").Range("A1")
End If
'---------------------------------------------------------------------------------------
'First, check to see if Target is in the RangeToMonitor
If Not Application.Intersect(Target, RangeToMonitor) Is Nothing Then
'If so, set your date. Rather than using a formula in the cell - which could go haywire if someone messes with it - just set it straight from VBA
RangeToChange.Value = Date - Weekday(Date) - 1
'Second, check to see if a change to Target *triggers* any recalculation of cells in RangeToMonitor.
'You can do this by looking at Dependents, which is all the cells affected by a change to Target, even several steps removed
ElseIf hasDependents(Target) Then
'(The above and below criteria cannot be done in one if condition because VBA boolean operators do not short circuit)
If Not (Application.Intersect(Target.Dependents, RangeToMonitor) Is Nothing) Then
RangeToChange.Value = Date - Weekday(Date) - 1
End If
End If
End Sub
'The reason for this function is that trying to use Target.Dependents when Target has no Dependents causes an error
'I use this function to verify that Target DOES have Dependents before attempting to find out if any of them affects RangeToMonitor
Private Function hasDependents(rng As Range)
On Error GoTo ErrHandler
Dim test As Long
test = rng.DirectDependents
hasDependents = True
Exit Function
ErrHandler:
If Err.Number = 1004 Then
'"No Cells Were Found"
'This error signifies that Target has no Dependents, so we can safely ignore the change and exit the event.
hasDependents = False
Else
Err.Raise Err.Number, , Err.Description
End If
End Function

Runtime error '28': Out of stack space in Excel VBA

I try to a create a workbook for my requirement. The first sheet include a cell which type is 'Text' and it is for DATE value.
I add Workbook_Open method for set today date when open the workbook as shown below.
Private Sub Workbook_Open()
Sheet1.Range("F6") = Date
End Sub
And I also add Worksheet_Change method for sheet of that cell. That is for validation check as below.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$F$6" Then
'Getting insertion date.
insertionDate = Sheet1.Range("F6")
'If date field is not empty
If insertionDate <> "" Then
Call MsgBox("Insertion Date must be inserted.")
End If
End If
End Sub
After that, I tested my code. When open the work book, I got the following error.
Run-time error '28':
Out of stack space
When click 'Debug' button, the cursor shown at the first line of Worksheet_Change method.
I has tried everything what I thought. But nothing is going on. Help me. Thank You.
I got it with this code. It is not satisfied for me but my problem is solved.
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Address = "$F$6" Then
'Getting insertion date.
insertionDate = Sheet1.Range("F6")
'If date field is not empty
If insertionDate <> "" Then
Call MsgBox("Insertion Date must be inserted.")
End If
End If
Application.EnableEvents = True
End Sub
Msgbox not need Call statement. Try to remove Call and test again.
And I have some reference from https://support.microsoft.com/en-us/kb/126090?wa=wsignin1.0. Its may be explain your error.
Possible sources of error marked in the code
Option Explicit ' Candidate
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$F$6" Then
'Getting insertion date.
Dim insertionDate as String ' Candidate
insertionDate = Sheet1.Range("F6").Text ' Candidate
'If date field is not empty
If insertionDate <> "" Then
MsgBox("Insertion Date must be inserted.") ' Candidate
End If
End If
End Sub
Make sure you placed Worksheet_Change in the sheet module.

How to clear cell when enter invalid data in Excel using VBA

I have an Excel sheet in which I am accepting value from the user when user enter a value a VBA will run which check the data is valid or not and if the data is not valid it will prompt a message saying invalid data. Here is my code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$12" Or Target.Address = "$D$13" Or Target.Address = "$D$14" Or Target.Address = "$D$15" Then
Call Room
End If
End Sub
Room method is
Sub Room()
Dim lastRow As Long
If IsNumeric(Range("i17")) Then
If [I17] < 0 Then
MsgBox "msg "
End If
End If
End Sub
In I17 cell I have a formula
=C6-(D12+(2*D13) + (2*D14) + (3*D15))
My problem is when wrong data is enter in any of the cells (D12, D13, D14, D15) then the cell should be clear automatically after showing prompt message.
How can this be done?
The first thing that you should do is clean up how you check what Target is. It could be multiple cells (Fill Down, paste a range, ...). This is accomplished by intersecting Target with the range you are interested in, and We'll store into a range variable, for later. If there is no overlap, then intersect will return an empty object, which we can test for with is Nothing.
The next thing to note is that odd things (infinite recursion) can happen if we allow the Worksheet_Change event to fire by changing a cell. To prevent this, we will turn off events before calling Room, and turn it back on after we're done.
Next we pass the range that has changed into room, so we can modify it from within that subroutine.
And, finally we modify the affected range after displaying the message. Note that I have used a command to literally clear the cell. Since you are performing calculations based on that data, you might prefer to set it to default value, like 0, using a.value = 0 instead.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim a As Range
Set a = Intersect(Target, Range("D12:D15"))
If Not a Is Nothing Then
Application.EnableEvents = False
Room a
Application.EnableEvents = True
End If
End Sub
Sub Room(a As Range)
Dim lastRow As Long
If IsNumeric(Range("I17")) Then
If Range("I17").Value < 0 Then
MsgBox "msg "
a.ClearContents
End If
End If
End Sub
As a side note, I have a used a bad variable name a, since I don't know what that range represents. You should pick something that describes to future maintainers what is going on.
use this
Private Sub Worksheet_Change(ByVal Target As Range)
Dim t As Range
Set t = Intersect(Target, [D12:D15])
Application.EnableEvents = 0
If Not t Is Nothing Then
Call Room
If [I17] < 0 Then Target.Value = ""
End If
Application.EnableEvents = 1
End Sub

Excel VBA - Capitalizing all selected cells in column on double click

I have a very simple VBA script, that capitalizes the selected cell:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
ActiveCell.Value = UCase(ActiveCell.Value)
End Sub
It works as expected, but sometimes I would like to capitalize all cells in a selected column, but only if I double click on the column itself. It seems that I cannot receive events with Worksheet_BeforeDoubleClick when clicking the column fields..
Is there some workaround for this?
Like I mentioned, Why not a shortcut key?. You can assign a shortcut key for your macro as shown below
Now all you have to do is select the column and press the shortcut key.
Also, instead of looping through every cell in a column, here is a code which is based on a ONE LINER HACK by Peter Albert.
Put this in a module.
Sub ChangeToUpper()
Dim rng As Range
'~~> Check if what the user selected is a valid range
If TypeName(Selection) <> "Range" Then
MsgBox "Select a range first."
Exit Sub
End If
Set rng = Selection
rng = WorksheetFunction.Transpose(Split(UCase(Join( _
WorksheetFunction.Transpose(rng), vbBack)), vbBack))
End Sub
Screenshot:
If DoubleClick is not mandatory, you could use BeforeRightClick. If you want to keep original right click context menu, you could import the module and check for Ctrl/Alt/Shift
Option Explicit
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim condition As Boolean
condition = True ' check Ctrl/Alt/Shift using http://www.cpearson.com/excel/KeyTest.aspx
If condition Then
MsgBox "Right Click at " & Target.Address
Cancel = True
End If
End Sub
Another option is to assign a Ctrl+[] in Macro options to a macro instead of an event handling and call the macro to process the Selection object.

Excel - Run-time error '1004': Unable to set the hidden property of the range class

I am new to scripting and I am trying to improve a existing Macro. I recorded a macro to remove duplicate and added it in a Main function which calls some other functions, but I am getting this error when I add the macro I recorded:
Run-time error '1004': Unable to set the hidden property of the range class
The code looks like
Private Sub Worksheet_Change(ByVal Target As Range)
Dim changed As Range
Set changed = Intersect(Target, Range("J15"))
If Not changed Is Nothing Then
Range("A48:A136").EntireRow.Hidden = True
Select Case Target.Value
Case "Agriculture"
Range("A48:A96").EntireRow.Hidden = False
Case "Commercial"
Range("A97:A136").EntireRow.Hidden = False
Case "MDP"
Range("A48:A61").EntireRow.Hidden = False
End Select
Range("J15").Select
End If
End Sub
Some possible answers:
You have a comment in one of the selected cells
You have some drawn objects which don't resize with text
Your worksheet is protected
When you set a breakpoint on the first line of the event handler, and then press F8 to step through the macro, I'm assuming it crashes on the line:
Range("A48:A136").EntireRow.Hidden = True
When people say "You have a comment in one of the selected cells", keep in mind that THE COMMENT CAN BE IN A DIFFERENT COLUMN.
If a comment box is over the column you're trying to hide (like if you're hiding every column to the right and you have comments in a completely different column), this is the error you'll get.
If you try to manually hide the column, you'll get a different confusing error which is something along the lines of "hiding this column will push an object off of the sheet."
The comment box a few columns over is the object.
^ This would have saved me about 40 minutes of debugging.
try this :)
Private Sub Worksheet_Change(ByVal Target As Range)
ActiveWorkbook.Unprotect "password_here"
Dim changed As Range
Set changed = Intersect(Target, Range("J15"))
If Not changed Is Nothing Then
Range("A48:A136").EntireRow.Hidden = True
Select Case Target.Value
Case "Agriculture"
Range("A48:A96").EntireRow.Hidden = False
Case "Commercial"
Range("A97:A136").EntireRow.Hidden = False
Case "MDP"
Range("A48:A61").EntireRow.Hidden = False
End Select
Range("J15").Select
End If
ActiveWorkbook.Protect "password_here"
End Sub
This should work for you :)