MsgBox SelectionChange define range - vba

I have written the following code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim myValue As Variant
If Range("B22") = "Yes" Then
myValue = InputBox("InsertInitialDetach")
Range("C22").Value = myValue
End If
End Sub
This code is meant to do the following thing: If I select Yes from a Yes/No drop down list, a message box appears and asks me to fill in a date.
The problem is that even after I fill the date, whatever I do afterwards, the box keeps on appearing and asking for the date. If I move two cells down, for example, the popup will continue to ask me for a date.
Please tell me what should I do to fix this error?

Would this be ok:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim myValue As Variant
If (Not Intersect(Range("B22"), Target) Is Nothing) And (Range("B22") = "Yes") Then
myValue = InputBox("InsertInitialDetach")
Range("C22").Value = myValue
End If
End Sub
It checks every time whether you are changing Range("B22") and whether Range("B22") "Yes".

You are using the selectionChange event which triggers after any change in the area selected, if want to trigger on value changes use the change event
Private Sub Worksheet_Change(ByVal Target As Range)
Dim myValue As Variant
On Error GoTo ErrorOccured
If Target.Address = "$B$1" And Target.Value = "Yes" Then
myValue = InputBox("Insert initialDetach")
Range("B2").Value = myValue
End If
ErrorOccured:
'Do when value is not valid
End Sub

Related

Stop NOW() Function from Auto Updating

I have a cell which I want to record the time when adjacent cells to the left are changed. I do it with the NOW() function; however, the problem is that the time gets updated each time workbook is re-calculated. So, I am wondering whether there is any original way to prevent this very cell from auto-updating.
My current formula in the cell:
=IF(ISBLANK(H11),"",IF(H11="Interested",NOW(),IF(H11="Not Interested",NOW(),"")))
I personally have come up with this:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Destination As Range
If Not Intersect(Target, Range("H:H")) Is Nothing Then
Target.Offset(0, 1).Value = Now
End If
End Sub
My issue with this code is that it is looking for any data in the cell. I am only wanting the cell to record the time when it contains either "Interested" or "Not Interested". The cell that I am looking at currently contains "In-progress". I have tried playing around with my code to try and incorporate these criteria's but I keep getting hit with errors. Any advice on what I can do to fix this? Thanks in advance.
Try the following code instead:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Destination As Range
If Not Intersect(Target, Range("H:H")) Is Nothing Then
If LCase(Trim(Target.Value2)) = "not interested" Or LCase(Trim(Target.Value)) = "interested" Then
Application.EnableEvents = False
Target.Offset(0, 1).Value = Now
Application.EnableEvents = True
End If
End If
End Sub
An alternative approach is a simple UDF that you use as =TimeChanged(H11)
Option Explicit
Option Compare Text
Public Function TimeChanged(theCell As Variant)
If TypeOf theCell Is Range Then theCell = theCell.Value2
If theCell = "Interested" Or theCell = "Not Interested" Then
TimeChanged = Now
Else
TimeChanged = ""
End If
End Function

VBA - Open a msgbox when cell value = 1

I need help with a very basic vba macro. When the value in A6 is equal 1 a msgbox needs to appear in the workstation. I developed the below code but the problem is that when I add any other information in the spreadsheet (for example, if I write "i love pizza" in B6) the msgbox will prompt again and I need it to prompt just one time, just when I set the value of A6 = 1. Could you please help me?
Private Sub Worksheet_Change(ByVal Target As Range)
If Range("A6").Value = 1 Then
MsgBox "THIS IS A MSGBOX."
End If
End Sub
#edit
I forgot one very important thing... the value "1" is getted with a VLOOKUP so its not insert manually by the user, i'm sorry about this. I tried the codes you people answered and it worked just when I put the vlue manually and as I said in the edit start, the value is set with a VLOOKUP. Any other tips, please?
You need to check if the change is due to the cell A6 being changed, rather than a different cell.
Try this:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 And Target.Row = 6 Then
If Target.Value = 1 Then
MsgBox "THIS IS A MSGBOX."
End If
End If
End Sub
You can use this code instead of the previous one
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = Me.Range("A6").Address And Me.Range("A6").Value = 1 Then
MsgBox "THIS IS A MSGBOX."
End If
End Sub
Target is the changed cell in Excel. so for every change event, I check if the target is Range("A6").
Pertaining to the statment : and I need it to prompt just one time, you need to save the oldvalue. So the prompt is displayed only once, when you set the value to 1. If A6 is already 1 and then you type 1 again, no prompt.
Option Explicit
Dim oldVal
Private Sub Worksheet_Change(ByVal Target As Range)
If (Target.Address = "$A$6") Then
If Target.Value = 1 And Target.Value <> oldVal Then
oldVal = Target.Value
MsgBox "Test"
End If
End If
End Sub
You need to check inside the Worksheet_Change event, that only if Cell "A6" is pressed, then continue. And afterwards, check if the value of the cell equals 1.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A6")) Is Nothing Then
If Target.Value = 1 Then MsgBox "THIS IS A MSGBOX."
End If
End Sub
Try this:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$6" Then
If Target.Value = 1 Then
MsgBox "THIS IS A MSGBOX."
End If
End If
End Sub
I forgot one very important thing... the value "1" is getted with a VLOOKUP so its not insert manually by the user, i'm sorry about this. I tried the codes you people answered and it worked just when I put the vlue manually and as I said in the edit start, the value is set with a VLOOKUP. Any other tips, please?

VBA - Open a UserForm by clicking anywhere in a specific column

I would like to build a makro in VBA which opens a UserForm when I click in a cell in a specific column, for more details look here.
With this code (from Mr.Burns):
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Selection.Count = 1 Then
If Not Intersect(Target, Range("A1")) Is Nothing Then
'name of userform .Show
End If
End If
End Sub
I was able to open the UserForm by clicking in the cell A1, but not by clicking in any cell inside the column A.
I tried to solve this problem with this code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Selection.Count = 1 Then
Dim check As Boolean
check = True
If check Then
Dim i As Long
For i = 1 To 100000
If Not Intersect(Target, Range("A" & i)) Is Nothing Then
UserForm1.Show
check = False
End If
Next
End If
End If
End Sub
It actually works fine, but it is very slow, is there any better possibility to solve this?
To display the form when a cell is selected in column A:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' if target is one cell and in column A
If Target.Columns.count = 1 And Target.Rows.count = 1 And Target.Column = 1 Then
UserForm1.Show
End If
End Sub
You can use .count and .column property together with AND and it will become so much simple and fast. Following code triggers pop-up if u click in column A on active-sheet
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo errorhandler
If Target.Count = 1 And Target.Column = 1 Then '.count to check if only one cell is selected and .column to check if it is a first column
'UserForm1.Show
'Do whatever you want to do here like opening User form
MsgBox "You clicked in column A"
End If
errorhandler:
End Sub

Selection.Count overflow when selecting all cells

In Excel 2007 I want to prompt a message when a cell (L2) is clicked on. I have a piece of code that works but the problem is that when I select all the cells in the sheet with Ctrl+A I get error number 06: overflow on the line If Selection.Count = 1 Then
Mandatory VBA code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Selection.Count = 1 Then
If Not Intersect(Target, Range("L2")) Is Nothing Then
MsgBox "ACTION!"
End If
End If
End Sub
Easily fixed:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Selection.CountLarge = 1 Then
If Not Intersect(Target, Range("L2")) Is Nothing Then
MsgBox "ACTION!"
End If
End If
End Sub
Try this:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If InStr(1, CStr(Target.Address), ":") < 1 Then
If Selection.Count = 1 Then
If Not Intersect(Target, Range("L2")) Is Nothing Then
MsgBox "ACTION!"
End If
End If
End If
End Sub
You must change your code as follows. No Error-Traps needed:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Selection.Area.Count = 1 Then
If Not Intersect(Target, Range("L2")) Is Nothing Then
MsgBox "ACTION!"
End If
End If
End Sub
If you had 64-bit Excel I would tell you to use CountLarge instead of Count. Excel 2007 only comes in the 32-bit variety so that's not an option for you.
Your problem is that Range.Count returns a Long variable and throws an error if the number of cells is greater than a Long can store.
To get around this, you can do the following:
Use a Decimal data type stored inside a Variant. The combination can count more than the 1,048,576 rows x 16,384 columns of cells in an Excel worksheet.
Count the cells one column at a time to avoid the error with Range.Count.
I wrote a function that does that. Save this function in a regular code module (not a Worksheet or Workbook module) and use it like this:
If CountLarge32(Selection) = 1 Then
Here's the actual function:
Public Function CountLarge32(ByVal rangeOrSelection As Variant) As Variant
Dim target As Excel.Range
On Error Resume Next
Set target = rangeOrSelection
On Error GoTo 0
Dim cnt As Variant
Dim iColumn As Excel.Range
If Not target Is Nothing Then ' parameter -IS- a valid Range
' Use Range.Count on one column at a time to avoid the overflow error
' if counting higher than the limit of the Long data type.
For Each iColumn In target.Columns
cnt = CDec(cnt + iColumn.Cells.Count)
Next iColumn
CountLarge32 = cnt
End If
End Function
This function also avoids the error that occurs if Select is an object (e.g. button, shape, chart, etc.) instead of a cell.

BeforeDoubleClick Event with multiple ranges

Good afternoon,
I am trying to utilize the BeforeDoubleClick event within a worksheet that calls an input box for column L that prompts users to input their ID and another call for an input box that prompts users to enter the name of a team member that is giving a tour in column J. The code I had worked fine when it was just one event within column L, but the addition of the inputbox within column J keeps returning the "compile error: Argument not optional". My current code is:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
On Error Resume Next
enterUserName Target
GuideName Target
End Sub
Sub enterUserName(ByVal Target As Range, Cancel As Boolean)
Dim x As Range, Y As Range
Set x = Target
Set Y = Range("L3:L300")
If Intersect(x, Y) Is Nothing Then Exit Sub
Cancel = True
t.Offset(0, 0).Value = InputBox(Prompt:="Please enter your User ID.")
End Sub
Sub GuideName(ByVal Target As Range, Cancel As Boolean)
Dim t As Range, B As Range
Set t = Target
Set B = Range("J3:J300")
If Intersect(t, B) Is Nothing Then Exit Sub
Cancel = True
t.Offset(0, 0).Value = InputBox(Prompt:="Please enter ONLY the first name of the tour guide.")
End Sub
Any help is greatly appreciated! Thanks!
Thank you, Matt -
After some further research and troubleshooting, the code is working for both events utilizing the BeforeDoubleClick event. The most helpful information came from Tushar Mehta's website: http://www.tushar-mehta.com/publish_train/xl_vba_cases/1021_multiple_tasks_in_an_event_procedure.htm
I made minimal changes to the last example on the website, and changed my original sub to the following (and everything is working like I had hoped):
Private Sub GoBeforeDoubleClick1(ByVal Target As Range, Cancel As Boolean)
Dim t As Range, B As Range
Set t = Target
Set B = Range("L3:L300")
If Intersect(t, B) Is Nothing Then
Exit Sub
Else: t.Offset(0, 0).Value = InputBox(Prompt:="Please enter your User ID.")
Exit Sub
End If
End Sub
Private Sub GoBeforeDoubleClick2(ByVal Target As Range, Cancel As Boolean)
Dim x As Range, Y As Range
Set x = Target
Set Y = Range("J3:J300")
If Intersect(x, Y) Is Nothing Then
Exit Sub
Else: x.Offset(0, 0).Value = InputBox(Prompt:="Please enter ONLY the first name of the tour guide.")
Exit Sub
End If
Cancel = True
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
On Error Resume Next
GoBeforeDoubleClick1 Target, Cancel
GoBeforeDoubleClick2 Target, Cancel
Application.EnableEvents = True
End Sub