I am sure that this is a simple answer, but I am unfamiliar with cases in VBA. What I am trying to do is create a case that monitors specific cells for changes.
If a change to the specified range occurs, then some macro should run as a response to that change. Else, nothing should happen. Here is what I have so far:
Private Sub Worksheet_Change(ByVal Target As Range)
Select Case (Change)
Case Range("A1").Address
Call success
Case Else
'Do nothing
End Select
End Sub
\\\\\\\\\\\\\\\\\\\\\\
Sub success()
' success Macro
Cells(1, 10).Value = "Success!"
End Sub
Problem is that nothing seems to happen. Mind you, this is just a test to understand cases, etc. Once I am provided with a solution I hope to expand this to something more intricate.
I have a feeling that it has something to do with the "Select Case (Change)" portion of the code, but I am unsure. Please don't respond to this question using an if/else statement, I would really like it in the form of a case. Thanks!
Select Case Target.Address(0, 0)
Case "A1": Call success
Case "A2": Call DoSomething
Case Else: Call OtherAction
End Select
NOTE
The Target parameter:
Can be several cells (or whole column or row)
Can contain non-contiguous ranges (in this case, you need to traverse Areas property to get those ranges)
A conciser example would look like that
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Const CELL1 = "A1"
Const CELL2 = "C2"
Const CELL3 = "D3"
Dim rg As Range
On Error GoTo ExitSub
Application.EnableEvents = False
Set rg = Union(Range(CELL1), Range(CELL2), Range(CELL3))
If Intersect(rg, Target) Is Nothing Then
' Do nothing
Else
Select Case Target.Address(0, 0)
Case CELL1
Call success(1)
Case CELL2
Call success(2)
Case CELL3
Call success(3)
Case Else
'Do nothing
End Select
End If
ExitSub:
Application.EnableEvents = True
End Sub
Sub success(i As Long)
' success Macro
Cells(i, 10).Value = "Success!"
End Sub
Related
I have a cell "A1" which varies the integer values from "1 to 150"
suppose if "A1"cell.Value ="1" then i should get msgbox containing its A1 value as "1".
and
if"A1"cell value = "2" then i should get msgbox containing its A1 value as "2"
similarly if A1 value is 3,4,5 and so on, then i should get respective cell value in msgbox
I wrote a code as seen below. but writing if code statement ranging from "1 to 150" is dificult task
can anybody minimise thise code adding variables to this.. thank you in advance
sub variable()
If Range("a1").Value = 1 Then
MsgBox Worksheets("Sheet1").Range("A1").Value
Else
If Range("a1").Value = 2 Then
MsgBox Worksheets("Sheet1").Range("A1").Value
Else
If Range("a1").Value = 3 Then
MsgBox Worksheets("Sheet1").Range("A1").Value
End If
End If
End If
End Sub
This is how to do rewrite the code with Select Case:
Sub MyVariable()
Select Case Range("A1").Value
Case 1 to 150:
MsgBox Range("A1")
Case Else:
'nothing
End Select
End Sub
I can suggest you to write this code :
Private Sub Worksheet_Change(ByVal Target As Range)
If (Target.Address = "$A$1") Then
If (IsNumeric(Target.Value)) Then
If (Target.Value >= 1 And Target.Value <= 150) Then
MsgBox Target.Value
End If
End If
End If
End Sub
If you want to get message each time you enter different value in cell A1 , then please use code below.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim DivRg As Range
Set DivRg = Range("A1")
Set DivRg = Application.Intersect(Target, DivRg)
If DivRg Is Nothing Then Exit Sub
MsgBox Target
Set DivRg = Nothing
End Sub
Please note you should put this code in your Worksheet module, not regular module.
It's the first time I'm trying some VBA code, so it might be a very noob mistake but I just can't see it, this is my code:
Private Sub Worksheet_Change(ByVal Target As Range)
If InRange(ActiveCell, Range("N4:N33")) Then
If InStr(1, ActiveCell.Text, "EFECTIVO") > 0 Then
If (Not IsEmpty(ActiveCell.Offset(0, -1))) Then
If (ActiveCell.Offset(0, -1).Value > 0) Then
Cancel = True
Call RestaEfectivo
Range("F4").Select
End If
End If
End If
End If
End Sub
Function InRange(Range1 As Range, Range2 As Range) As Boolean
InRange = Not (Application.Intersect(Range1, Range2) Is Nothing)
End Function
Sub RestaEfectivo()
Range("F4").Value = Range("F4").Value - ActiveCell.Offset(0, -1).Value
End Sub
The idea is that I have a dropdown list on my cells N4 to N33, whenever I choose the option "EFECTIVO" it should take the value to the left of the ActiveCell (N#) and substract its value from the F4 cell. In essence F4 = F4 - N#.
The code does what it's supposed to do, however, it appears to execute 50 times? The original value of my F4 cell is 230, once I execute the code it turns into -20
Any idea where I messed up or if I'm missing some code, validation, etc?
As I said, I'm new to VBA for Excel Macros, so don't worry about pointing out noob mistakes.
You need to toggle the EnableEvents property of Application at the point where you call your RestaEfectivo sub-routine. Notice that during handling the Worksheet_Change event you call the RestaEfectivo sub-routine which fires the worksheet change event again - that is why your macro executes more than once.
You can make the code change like this:
Cancel = True
' turn off events to enable changing cell value without a new 'change' event
Application.EnableEvents = False
Call RestaEfectivo
' re-enable events to ensure normal application behaviour
Application.EnableEvents = True
Range("F4").Select
Update
OP asked a follow up question - how to make the range dynamic but ignore the bottom row as this would contain a SUM formula.
One possible solution is to check for the change in any cell of column N:
If InRange(ActiveCell, Range("N:N")) Then
And then recode the InRange sub - see the code comments for logic and assumptions:
Function InRange(Range1 As Range, Range2 As Range) As Boolean
Dim blnInRange As Boolean
Dim blnResult As Boolean
Dim blnCellHasSumFormula As Boolean
Dim blnCellIsEmpty As Boolean
'primary check for cell intersect
blnInRange = Not (Application.Intersect(Range1, Range2) Is Nothing)
If blnInRange Then
'follow-up checks
blnCellIsEmpty = (Range1.Value = vbNullString)
If blnCellIsEmpty Then
'cell in range but empty - assume beneath row with SUM
blnResult = False
Else
If Range1.HasFormula Then
'check for sum formula
blnCellHasSumFormula = (InStr(1, Range1.Formula, "SUM(", vbTextCompare) > 0)
If blnCellHasSumFormula Then
' cell in the SUM row
blnResult = False
Else
' cell is in range, not empty and not a SUM formula
blnResult = True
End If
Else
'assume non-empty cell without formula is good
blnResult = True
End If
End If
Else
blnResult = False
End If
'return to event handler
InRange = blnResult
End Function
I'm trying to create a MsgBox that automatically pops up with a prompt of "Yes or No" when a cell in a column changes from blank to "News", and to put the answer into the next column.
I will be continuing to add to rows over time so it has to automatically pop up when the cell changes from blank to "news" and input the answer into the newly added cell to the right.
I'm pretty sure I need the For each loop, but honestly I'm a little lost and get a mismatch error during debug at the If Intersect line.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim myRange As Range
Set myRange = Range("G2:G1000")
If Intersect(myRange, Target) Then
If Range("G2").Value = "News" Then Answer = MsgBox("Good?", vbYesNo)
Answer = ActiveCell.Offset(0, 1) = 1 'not sure if this is right, or is it Range.Offset?
Dim cel As Range
For Each cel In Range("G2:G1000")
If cel.Value = "News" Then Answer = MsgBox("Good?", vbYesNo)
Answer = ActiveCell.Offset(0, 1) = 1 'not sure if this is right, or is it Range.Offset?
Exit For
Next
End If
End Sub
Here you go:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Column = 7 Then
If Target.Count = 1 Then
If LCase$(Target) = "news" Then
Application.EnableEvents = False
Target(, 2) = Array("Yes", "No")(MsgBox("Good?", vbYesNo) - 6)
End If
End If
End If
Application.EnableEvents = True
End Sub
I'm trying to automatically update the "Updated" column of an excel spreadsheet when any cell of that specific row changes to today's date. I was able to do this by hard-coding where the "Updated" column header would be, however, it is now necessary to search for that column header as it may move.
The code I am trying to implement works but immediately gives me the error Automation error - The object invoked has disconnected from it's clients.
Any help would be appreciated. Here is the code I have currently:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A:DX")) Is Nothing Then
Dim f As Range
Set f = ActiveSheet.Range("A1:DD1").Find("Updated", lookat:=xlWhole)
' f.Row = Range(Target).Row
If Not f Is Nothing Then
Range(Split(f.Address, "$")(1) & Target.Row).Value = Now
Else
MsgBox "'Updated' header not found!"
End If
End If
End Sub
You got into an endless loop.
Try this:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A:DX")) Is Nothing Then
Dim f As Range
Set f = ActiveSheet.Range("A1:DD1").Find("Updated", lookat:=xlWhole)
' f.Row = Range(Target).Row
If f Is Nothing Then
MsgBox "'Updated' header not found!"
ElseIf Intersect(Target, f.EntireColumn) Is Nothing Then
Intersect(Target.EntireRow, f.EntireColumn).Value = Now
' Else
' MsgBox "We entered this function again because the row above updated the Updated column", vbInformation, "False alarm"
End If
End If
End Sub
To understand what happens,
Uncomment the else and MsgBox
Put a breakpoint on the MsgBox
When you hit it, press [ctrl]-L
In a case such as this, I run into far fewer problems when I simply loop through the available cells to find the column header. Using the .Find method also works, but is less "tunable" to my needs in a custom application.
Public Function FindColumn(header As String) As Long
Dim lastCol As Long
Dim headerCol As Long
Dim i As Long
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("VTO2 Labor")
lastCol = sh.Cells(1, sh.Columns.Count).End(xlToLeft).Column
headerCol = 0
For i = 1 To lastCol
If sh.Cells(1, i).Value = header Then
headerCol = i
End If
Next i
FindColumn = headerCol
End Function
It isn't clear on whether the Updated column header could be in row 1 or if it will always be in row 1, just not in the same location.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A:DX")) Is Nothing Then
On Error GoTo bm_SafeExit
'TURN OFF EVENTS IF YOU ARE GOING TO WRITE A VALUE INTO THE WORKSHEET!
Application.EnableEvents = False
Dim uCol As Long, f As Range
If Application.CountIf(Rows(1), "updated") Then
uCol = Application.Match("updated", Rows(1), 0)
For Each f In Intersect(Target, Range("A:DX"))
If f.Row > 1 Then _
Cells(f.Row, uCol) = Now
Next f
Else
MsgBox "'Updated' header not found!"
End If
End If
bm_SafeExit:
Application.EnableEvents = True
End Sub
That should survive multiple updates (e.g. when pasting values). The problem I see is that is the Updated column is being shifted around, presumably through inserting columns or the like, then the change routine is going to run.
I have the following code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
On Error Resume Next
Dim StartBox As Long
Dim StartBox2 As Long
Select Case UCase(Target.Value)
Case "NEW-BOX"
StartBox = ActiveCell.Row
StartBox2 = ActiveCell.Column
MsgBox (StartBox)
MsgBox (StartBox2)
Selection.Offset(-1, 2).Select
Selection.ClearContents
Selection.Activate
Selection.Offset(1, -2).Select
Case "RESTART-BOX"
MsgBox (StartBox)
MsgBox (StartBox2)
If StartBox = 0 And StartBox2 = 0 Then
MsgBox "Cannot restart box without scanning a new box first!", vbCritical
ElseIf StartBox <> 0 And StartBox2 <> 0 Then
ActiveSheet.Range(Cells(StartBox, StartBox2), Cells(ActiveCell.Row, ActiveCell.Column)).ClearContents
End If
End Select
End Sub
I scan a new box, and the variables set to the correct columns and row, but when I scan restart box, the message boxes both come up 0? Why is this? I need to pass these variables onto my code to clear the contents, but for some reason even though I am setting them they won't appear in 'RESTART-BOX' ?
We need more context to be able to provide a definitive answer. Is your code in a loop of some sort or is this a sub or function being called multiple times?
If the latter then you will get a new copy of StartBox and StartBox2 created each time you call the sub / function, so they won't retain the values. If you place the dim statements outside the sub or function then they will become global variables and will retain their values across each call to the sub or function.
You'll need to set your 2 variables before your select statement:
...
StartBox = ActiveCell.Row
StartBox2 = ActiveCell.Column
Select Case UCase(Target.Value)
...