worksheet_SelectionChange for a specific column - excel

I have a worksheet that contains invoice numbers in column D. I'd like to copy the invoice number to another worksheet ("Details") when one is selected. I've added the "If IsNumeric" condition to make sure that only cells containing an invoice # will be copied over. The code seems to do nothing, can anyone help point me in the right direction?
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 4 Then
On Error Resume Next
Application.EnableEvents = False
If IsNumeric(Target.Value) Then
Sheets("Detail").Range("A5").Value = Target.Value
Application.EnableEvents = True
Sheets("Detail").Activate
End If
End If
End Sub

Rather than:
IsNumeric(Target.Address)
try
IsNumeric(Target)
EDIT#1:
Try this:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 4 Then
Application.EnableEvents = False
If IsNumeric(Target.Value) Then
Target.Copy Sheets("Detail").Range("A5")
End If
Application.EnableEvents = True
End If
End Sub
EDIT#2:
You need to re-enable events within the same IF
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 4 Then
On Error Resume Next
If IsNumeric(Target.Value) Then
Application.EnableEvents = False
Sheets("Detail").Range("A5").Value = Target.Value
Sheets("Detail").Activate
Application.EnableEvents = True
End If
End If
End Sub

Related

Data validation to a dynamic range

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

Execute code if the value entered in the cell is not the same as the previous value

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

Excel 2 Worksheets Events with Different Targets

I have an excel worksheet that I want to assign to it more than one Worksheet Event.
To be more specific, I want whenever a cell in column B is changed then one cell to the left (column A) gets the row number.
Also I want whenever a cell in column J is changed then one cell to the right (column K) gets today's date.
It worked for me for both of them individually but I think I may be doing something wrong using them together.
Any help will be much appreciated!
Private Sub AG1(ByVal a_Target As Range)
If Not Intersect(a_Target, Me.Range("B2:B3000")) Is Nothing Then
Application.EnableEvents = False
Cells(a_Target.Row, a_Target.Column - 1) = a_Target.Row
Application.EnableEvents = True
End If
End Sub
Private Sub AG2(ByVal b_Target As Range)
If Not Intersect(b_Target, Me.Range("J2:J3000")) Is Nothing Then
Application.EnableEvents = False
Cells(b_Target.Row, b_Target.Column + 1) = Date
Application.EnableEvents = True
End If
End Sub
edit - works now (I also added that column can be referred as letter):
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = True
If Split(Cells(1, Target.Column).Address(True, False), "$")(0) = "B" Then
Application.EnableEvents = False
Cells(Target.Row, Target.Column - 1) = Target.Row
Application.EnableEvents = True
ElseIf Split(Cells(1, Target.Column).Address(True, False), "$")(0) = "J" Then
Application.EnableEvents = False
Cells(Target.Row, Target.Column + 1) = Date
Application.EnableEvents = True
End If
End Sub
Copy the code in the Worksheet_Change event and that should fix your issue. This will trigger every time you enter a value for any cell and will only meet the condition if they intersect the range in the if statement.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Me.Range("B2:B3000")) Is Nothing Then
Application.EnableEvents = False
Cells(Target.Row, Target.Column - 1) = Target.Row
Application.EnableEvents = True
End If
If Not Intersect(Target, Me.Range("J2:J3000")) Is Nothing Then
Application.EnableEvents = False
Cells(Target.Row, Target.Column + 1) = Date
Application.EnableEvents = True
End If
End Sub

conditional formatting with Case more then one selected

I have a VBA like below but when i copy more then 1 cell i get a error because of the multiple selection.
Is it possible to make a action that the Case looks at the selected cells one after the other? Or do i have the wrong Statment?
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("$G$8:$OA$92")) Is Nothing Then
With Target
Select Case .Value
Case Is = "Weekend"
.Interior.ColorIndex = 48
Case Is = "VRIJ", "ADV"
.Interior.ColorIndex = 6
End Select
End With
End If
End Sub
Loop through the cells in the intersect.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("G8:OA92")) Is Nothing Then
on error goto meh
application.enableevents = false
dim t as range
for each t in Intersect(Target, Range("G8:OA92"))
With t
Select Case lcase(.Value2)
Case "weekend"
.Interior.ColorIndex = 48
Case "vrij", "adv"
.Interior.ColorIndex = 6
case else
.interior.pattern = xlnone
End Select
End With
next t
End If
meh:
application.enableevents = true
End Sub

Clear the cell of column B if cell A is empty - RANGE

Got a problem and looking for some advice. I've been using the below code for a while now in Excel, it clears the contents of column B if cell A is empty. It works great, but I now need it to work for a specific range (A6:B35). Any ideas?
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Column = 1 Then
If Target.Validation.Type = 3 Then
Application.EnableEvents = False
Target.Offset(0, 1).ClearContents
End If
End If
exitHandler:
Application.EnableEvents = True
Exit Sub
End Sub
You need to test if the active cell (target) falls in the range A6:A35. Like this:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If not intersect(target, range("A6:A35")) is nothing then
If Target.Validation.Type = 3 Then
Application.EnableEvents = False
Target.Offset(0, 1).ClearContents
Application.EnableEvents = True
End If
End if
exitHandler:
End Sub
You should also indent your code so it is more readable. It will help with loops and IF statements.
something like
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng1 As Range
Dim rng2 As Range
Set rng1 = Intersect(Target, Range("A6:B35"))
If rng1 Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each rng2 In rng1
If rng2.Validation.Type = 3 Then rng2.Offset(0, 1).ClearContents
Next
Application.EnableEvents = True
End Sub

Resources