I have a column named "time" in my excel sheet. I want to write a code such that whenever user performs an entry in time column, if it is a whole number, it should accept, but if it is not a pop up should appear saying "only numbers allowed". Also, the validation should be dynamic i.e. should automatically validate next row if users enters a new entry
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Column = Range("Meeting Time").Column Then
If Not (IsNumeric(Target.Value)) Then
MsgBox "only numbers allowed"
Target.Value = ""
Target.Select
End If
End If
End Sub
You could try:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
'1. Check if the column that affected is B (change to the column you want)
'2. Check if changed field is one (used to avoid errors if user change more than one cells at the same time)
If Not Intersect(Target, Columns("B:B")) Is Nothing And Target.Count = 1 Then
'Check if target is numeric
If Not IsNumeric(Target.Value) Then
Call Clear(Target)
End If
'Check if target.offset(1,0) is numeric
If Not IsNumeric(Target.Offset(1, 0).Value) Then
Call Clear(Target.Offset(1, 0))
End If
End If
End Sub
Sub Clear(ByVal rng As Range)
'Disable events in order to prevent code to re trigger when clear cell
Application.EnableEvents = False
rng.Value = ""
'Enable events
Application.EnableEvents = True
End Sub
EDITED VERSION:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
'1. Check if the column that affected is B (change to the column you want)
'2. Check if changed field is one (used to avoid errors if user change more than one cells at the same time)
If Not Intersect(Target, Columns("B:B")) Is Nothing And Target.Count = 1 Then
'Check if target is numeric
If Not IsNumeric(Target.Value) Then
Call Clear(Target)
ElseIf Target.Value > 160 Or (Target.Value = Int(Target.Value) = False) Then
Call Clear(Target)
End If
'Check if target.offset(1,0) is numeric
If Not IsNumeric(Target.Offset(1, 0).Value) Then
Call Clear(Target.Offset(1, 0))
ElseIf Target.Offset(1, 0).Value > 160 Or (Target.Offset(1, 0).Value = Int(Target.Offset(1, 0).Value) = False) Then
Call Clear(Target)
End If
End If
End Sub
Sub Clear(ByVal rng As Range)
'Disable events in order to prevent code to re trigger when clear cell
Application.EnableEvents = False
rng.Value = ""
'Enable events
Application.EnableEvents = True
End Sub
first you can create a range name for column you want your "time" and you can use the sample codes below.
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Column = Range("time").Column Then
If Not (IsNumeric(Target.Value)) Then
MsgBox "only numbers allowed"
Target.Value = ""
Target.Select
End If
End If
End Sub
Related
I would like to add an additional '-' sign to the value in the Hours column if the status is changed from 'Pending' to 'Completed'.
I tried the "Worksheet_Change" event but I do not see any changes in my worksheet.
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("C5:C14")) Is Nothing Then Exit Sub
Application.EnableEvents = False
With Intersect(Range("C5:C14"), Target)
.Offset(, -1).Value = -.Offset(, -1).Value
.ClearContents
End With
Application.EnableEvents = True
End Sub
I need to copy the contents of a cell in a particular column to another corresponding column on change so the old value is moved. Only wants to work for a particular column.
Private sub Worksheet_Change(ByVal Target As Range)
if Target.Range("L:L") then
'set I cell value = to original L cell value
ActiveCell.Offset(0,-3).Value = ActiveCell.Value
End If
End Sub
This code should do what you want. Please take note of the comments which explain some limitations I have imposed on the action of this procedure. The rule to follow is to not give it more power than it needs to do the job you want it to do.
Private Sub Worksheet_Change(ByVal Target As Range)
' 027
Dim Rng As Range
' don't react if the changed cell is in row 1 or
' if it is more than 1 row below the end of column L
Set Rng = Range(Cells(2, "L"), Cells(Rows.Count, "L").End(xlUp).Offset(1))
If Not Application.Intersect(Target, Rng) Is Nothing Then
With Target
' skip if more than 1 cell was changed
' meaning, exclude paste actions
If .Cells.CountLarge = 1 Then
.Offset(0, -3).Value = .Value
End If
End With
End If
End Sub
This will save the previous value in column I:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim v As Variant
If Target.Count > 1 Then Exit Sub
If Intersect(Range("L:L"), Target) Is Nothing Then Exit Sub
With Application
v = Target.Value
.EnableEvents = False
.Undo
Target.Offset(0, -3).Value = Target.Value
Target.Value = v
.EnableEvents = True
End With
End Sub
EDIT#1:
To update L without triggering the event, use something like:
Sub ScriptThatUpdatesColumn_L()
Application.EnableEvents = False
Range("L5").Value = "just me"
Application.EnableEvents = True
End Sub
I have data validation as list for some cells (possible values are "Enrolled", "Waitlisted", "Cancelled"). I need to execute some code if the value of these cells changes, only if the new value is not the same as the existing one. Question is, how can I get Excel to compare the previous value of the cell with the current one.
I tried this solution (How do I get the old value of a changed cell in Excel VBA?) but it didn't work. What am I missing? Here is some sample code. Currently, it changes the cell colors even if I enter the same value.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim previous_value As String
previous_value = oval
Select Case Target.Value
Case Is = "enrolled"
If previous_value = Target.Value Then
MsgBox "you entered the same value"
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
Else
Target.Interior.Color = vbBlue
End If
Case Is = "waitlisted"
' (....etc.)
End Select
End Sub
Public Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim oval As String
If Selection.Cells.Count = 1 Then
oval = Target.Value
End If
End Sub
If you use something like this below code, you can save the most recent clicked instance in a named range and then check it against whatever the user entered. Obviously, this goes in the respective sheet code.
Private anOldValue As Variant
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count = 1 Then
If Target.Value = anOldValue Then
MsgBox "Same value!"
End If
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count = 1 Then
anOldValue = Target.Value
End If
End Sub
Here is the final code. Thanks #PGCodeRider for the help!
Private anOldValue As Variant
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count = 1 Then
Select Case Target.Value
Case Is = "enrolled"
If Target.Value = anOldValue Then
MsgBox "Student already enrolled!"
Else 'code that needs to happen when "enrolled" is selected
Target.Interior.ColorIndex = 10
End If
Case Is = "waitlisted"
If Target.Value = anOldValue Then
MsgBox "Student already waitlisted!"
Else 'code that needs to happen when "waitlisted" is selected
Target.Interior.ColorIndex = 20
End If
Case Is = "cancelled"
If Target.Value = anOldValue Then
MsgBox "Student already cancelled!"
Else 'code that needs to happen when "cancelled" is selected
Target.Interior.ColorIndex = 30
End If
End Select
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count = 1 Then
anOldValue = Target.Value
End If
End Sub
I have a macro enabled work sheet in which i have data validations for columns where i want to regulate the data input. I cannot use regular data validation feature in excel as it fails to function as we copy data from other sources which is the case in my requirement.So i am implementing data validations through macros . I have a scenario where one column can input only decimal data. The conditions are as follows the input data is of length 9 which constitutes only 2 decimal positions. I have partly written a macro for this validation which does not work(When i make a invalid input macro is not triggered therefore no msgbox pop up) and i am stuck at this point.Please help me out here to find a different if condition for the validation. The macro i have written is as follows:
Set AffectedCells = Intersect(Target, Target.Parent.Range("F:F"))
If Not AffectedCells Is Nothing Then
For Each Cell In AffectedCells
If Not (Cell.Value * (10 ^ 2) Mod 10) <> 0 Then
MsgBox "The value you entered is not valid."
Application.Undo 'undo insert
Exit Sub 'stop checking after one invalid data was found.
End If
This needs to be pasted on the sheet code space for the sheet you want the macro to run on.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim xCell As Range, AffectedCells As Range
Set AffectedCells = Intersect(Target, Target.Parent.Range("F:F"))
If Not AffectedCells Is Nothing Then
For Each xCell In AffectedCells
If Not (xCell.Value * (10 ^ 2) Mod 10) <> 0 Then
MsgBox "The value you entered is not valid."
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
Exit Sub
End If
Next xCell
End If
End Sub
Is this what you are trying? I have commented the code so you should not have a problem undrstanding it. But if you do then simply ask.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim xCell As Range, AffectedCells As Range
On Error GoTo Whoa
Application.EnableEvents = False
Set AffectedCells = Intersect(Target, Columns(6))
If Not AffectedCells Is Nothing Then
For Each xCell In AffectedCells
'~~> Avoid cases like IP address 10.1.2.234
'~~> Check if the number contains decimal
If IsNumeric(xCell.Value) And _
Int(xCell.Value) <> xCell.Value Then
'~~> Check the position of the decimal
'~~> Check the length of the string
If Mid(xCell.Value, Len(xCell.Value) - 2, 1) <> "." Or _
Len(xCell.Value) > 9 Then
'
'~~> INVALID INPUT: Do what you want
'
'MsgBox "The value you entered is not valid."
'Application.Undo
'Exit For
End If
End If
Next xCell
End If
Letscontinue:
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume Letscontinue
End Sub
I have code that retrieves information from SQL and VFP and populates a dropdown list in every cell in column "A" except A1 - this is a header.
I need to populate the "G" column on the row where the user selects the value from a dropdown in the "A" column.
I believe I need to be in Private Sub Worksheet_SelectionChange(ByVal Target As Range) which is in the sheet object.
Below is something similar to what I want to do.
If cell "a2".valuechanged then
Set "g2" = "8000"
End if
If cell "a3".valueChanged then
Set "g3" = "8000"
End if
The code above doesn't work, but I think it is easy to understand. I want to make this dynamic, so I don't have too many lines of code.
I have already explained about events and other things that you need to take care when working with Worksheet_Change HERE
You need to use Intersect with Worksheet_Change to check which cell the user made changes to.
Is this what you are trying?
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Whoa
'~~> Check if user has selected more than one cell
If Target.Cells.CountLarge > 1 Then Exit Sub
Application.EnableEvents = False
'~~> Check if the user made any changes in Col A
If Not Intersect(Target, Columns(1)) Is Nothing Then
'~~> Ensure it is not in row 1
If Target.Row > 1 Then
'~~> Write to relevant cell in Col G
Range("G" & Target.Row).Value = 8000
End If
End If
Letscontinue:
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume Letscontinue
End Sub
Try this
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row > 1 And Target.Column <> 7 Then
Cells(Target.Row, "G").Value = 8000
End If
End Sub
If you only need it to fire on column A then
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row > 1 And Target.Column = 1 Then
Cells(Target.Row, "G").Value = 8000
End If
End Sub
can you not put an if statement in column G , as in
If (A1<>"", 8000,0)
Other wise something like this will get you going:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Column = 1 Then
If Target.Value2 <> "" Then
Target.Offset(0, 6) = "8000"
Else
Target.Offset(0, 6) = ""
End If
End If
On Error GoTo 0
End Sub
Thanks
Ross
I had a similar problem. I used Siddharth Rout's code. My modifications allow a user to paste a range of cells in column a (ex. A3:A6) and have multiple cells modified (ex. H3:H6).
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Whoa
'~~> Check if user has selected more than one cell
If Target.Cells.CountLarge < 1 Then Exit Sub
If Target.Cells.CountLarge > 500 Then Exit Sub
Debug.Print CStr(Target.Cells.CountLarge)
Application.EnableEvents = False
Dim the_row As Range
Dim the_range As Range
Set the_range = Target
'~~> Check if the user made any changes in Col A
If Not Intersect(the_range, Columns(1)) Is Nothing Then
For Each the_row In the_range.Rows
'~~> Ensure it is not in row 2
If the_row.Row > 2 Then
'~~> Write to relevant cell in Col H
Range("H" & the_row.Row).Value = Now
End If
Next
End If
Letscontinue:
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume Letscontinue
End Sub