View Full Version : Solved: Worksheet_Change Question
The following snippet does exactly what it's designed to do. If I add a value (create a new record) within the defined range, it automateically inserts the current date in the cell adjacent (to the right) of the Target. Then, if I change my mind and immediately clear the value from the Target range, it removes the date from the adjacent cell.
If Not Intersect(Target, Range("$A1:$A10")) Is Nothing Then
If Target <> "" Then
Target.Offset(0, 1).Value = Date
Else: Target.Offset(0, 1).Value = ""
End If
End If
However, if I notice an error (say a misspelled word, etc) in a previously entered cell, I also want to be able to correct that cell WITHOUT changing the date in the adjacent cell, as the date in that field is correct as of the date that record was added. How could the above code be modified to accommodate such a correction?
Thanks,
Opv
mdmackillop
03-21-2010, 03:40 PM
Option Explicit
Dim PrevVal
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
Application.EnableEvents = False
If Not Intersect(Target, Range("$A1:$A10")) Is Nothing Then
If IsEmpty(PrevVal) Then
If Target <> "" Then Target.Offset(0, 1).Value = Date
Else
If Target = "" Then Target.Offset(0, 1).ClearContents
End If
End If
Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("$A1:$A10")) Is Nothing Then
PrevVal = Target
End If
End Sub
Bob Phillips
03-21-2010, 04:49 PM
Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "A1:A10" '<== change to suit
On Error GoTo ws_exit
Application.EnableEvents = False
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target
If Not IsDate(.Offset(0, 1).Value2) Then
.Offset(0, 1).Value2 = Date
End If
End With
End If
ws_exit:
Application.EnableEvents = True
End Sub
Thanks! I can't seem to get it to work on two fronts. First, when a historical entry is corrected, it overwrites the past date with the current date. Second, it does not clear the current date on the new entry if the name is removed.
I've attached a small sample worksheet with the suggested code applied. Please let me know if I've done something wrong.
Thanks again,
Opv
quote=xld]
Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "A1:A10" '<== change to suit
On Error GoTo ws_exit
Application.EnableEvents = False
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target
If Not IsDate(.Offset(0, 1).Value2) Then
.Offset(0, 1).Value2 = Date
End If
End With
End If
ws_exit:
Application.EnableEvents = True
End Sub
[/quote]
Option Explicit
Dim PrevVal
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
Application.EnableEvents = False
If Not Intersect(Target, Range("$A1:$A10")) Is Nothing Then
If IsEmpty(PrevVal) Then
If Target <> "" Then Target.Offset(0, 1).Value = Date
Else
If Target = "" Then Target.Offset(0, 1).ClearContents
End If
End If
Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("$A1:$A10")) Is Nothing Then
PrevVal = Target
End If
End Sub
I must be missing something. I couldn't get this code to work either. Now, I think I've done something inadvertently to my system. Now I can't get any Worksheet_Change or Worksheet_SelectionChange code to work, not even a simple test msgbox.
mdmackillop
03-22-2010, 01:02 AM
Run this macro
Sub Enables
Application.EnableEvents = True
End Sub
Bob Phillips
03-22-2010, 03:04 AM
I checked mine out and whilst it 'worked' it neeeded a tweak
Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "A1:A10" '<== change to suit
On Error GoTo ws_exit
Application.EnableEvents = False
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target
If Not IsDate(.Offset(0, 1).Text) Then
.Offset(0, 1).Value2 = Date
End If
End With
End If
ws_exit:
Application.EnableEvents = True
End Sub
Run this macro
Sub Enables
Application.EnableEvents = True
End Sub
Thanks. That got me back to detecting changes.
Opv
I checked mine out and whilst it 'worked' it neeeded a tweak
Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "A1:A10" '<== change to suit
On Error GoTo ws_exit
Application.EnableEvents = False
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target
If Not IsDate(.Offset(0, 1).Text) Then
.Offset(0, 1).Value2 = Date
End If
End With
End If
ws_exit:
Application.EnableEvents = True
End Sub
Thanks, as always for the help. This code solved one of my issues. It successfully allows me to correct a previous entry and leave the original date intact. However, it's still does not appear to also be clearing the date if the name is removed from the on the most recent entry. On that note, clearing the date if the name is cleared should only occur if it is the most recent entry.
On a related note, please explain the difference between Range(WS_RANGE) and Me.Range(WS_RANGE)?
Thanks again,
Opv
Well, I got your code to work by adding several lines. I'm sure there is a more efficient way to accomplish my goal, but the following modified code seems to be working so far. Please let me know what you think.
Oh, I'm still interested in the significance of "Me" in Me.Range. Thanks.
Opv
Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "A1:A10" '<== change to suit
On Error GoTo ws_exit
Application.EnableEvents = False
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target
If Not IsDate(.Offset(0, 1).Text) Then
.Offset(0, 1).Value2 = Date
End If
End With
End If
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
If Target.Value = "" Then
If Target.Offset(1, 0).Value = "" Then
Target.Offset(0, 1).Value = ""
End If
End If
End If
ws_exit:
Application.EnableEvents = True
End Sub
Bob Phillips
03-22-2010, 09:13 AM
Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "A1:A10" '<== change to suit
On Error GoTo ws_exit
Application.EnableEvents = False
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target
If .Value2 = "" Then
If .Offset(1, 0).Value = "" Then
.Offset(0, 1).Value = ""
End If
ElseIf Not IsDate(.Offset(0, 1).Text) Then
.Offset(0, 1).Value2 = Date
End If
End With
End If
ws_exit:
Application.EnableEvents = True
End Sub
Me refers to the containing object, the worksheet in this case, so it is a range within the worksheet.
Me refers to the containing object, the worksheet in this case, so it is a range within the worksheet.
Thanks. Works great.
I've run into a snag. I attempted to expand the code to automatically fill several additional column in addition to the date column. My Changes are inserted between comment tags below. The code does insert all the proper cells and it clears those cells on the most recent row of data if I remove the name from the name field. However, something in what I've added causes the data in previous rows to be changed or cleared as well, rather than leaving the historical data as is. What needs to be changed to make the new lines of code function like the original code? (Note that I've changed the range so that the actual data rows begin on Row 4.)
Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "$A$4:$A15" '<== change to suit
On Error GoTo ws_exit
Application.EnableEvents = False
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target
If .Value2 = "" Then
If .Offset(1, 0).Value = "" Then
.Offset(0, 1).Value = ""
'''''''' TEST '''''''''''''
.Offset(0, 3).Value = "" 'Hours worked column
.Offset(0, 4).Value = "" 'Rate column
.Offset(0, 6).Value = "" 'Debit column
''''''''' END TEST ''''''''''
End If
ElseIf Not IsDate(.Offset(0, 1).Text) Then
.Offset(0, 1).Value2 = Date
'''''''' TEST '''''''''''''
.Offset(0, 3).Value = 0 'Hours worked column
.Offset(0, 4).Value = Range("$E$2").Value 'Rate cell
.Offset(0, 6).Value = 0 'Debit column
''''''''' END TEST ''''''''''
End If
End With
End If
ws_exit:
Application.EnableEvents = True
End Sub
Bob Phillips
03-24-2010, 01:06 AM
I cannot reporduce that. Can you give more details?
I cannot reporduce that. Can you give more details?
This is strange. I just created a new workbook from scratch with some test data, copied and pasted the code to the new sheet and it works perfectly as intended. However, in the actual workbook that contains my data, the same identical code is responding differently.
As you recall, my original objective was to be able to automatically populate NEW rows of data and then to be able to change my mind, clear the name from the name field and have the cells to the right automatically cleared as well. However, for historical rows, I only wanted to be able to correct the name in the name field without clearing or changing the cells in the columns to the right.
Something in the production workbook is causing the code to respond differently for historical rows than it does in the newly created workbook. The odd thing about this is that if I remove my test rows, the code then works properly in both my production workbook and the new test workbook.
Bob Phillips
03-24-2010, 12:40 PM
Can you post the offending workbook with the modified code?
Can you post the offending workbook with the modified code?
Here is a sample.
Thanks,
Opv
Bob Phillips
03-24-2010, 01:53 PM
I can't see anything untoward happening. Can you talk me through the problem?
I can't see anything untoward happening. Can you talk me through the problem?
Do you mean it's working for you? As I said earlier, the code is suppose to be accomplishing three things:
1. When a name is entered in the name column, the cells to the right are to be automatically populated.
2. If I change my mind on the newest row only and remove the name, the cells to the right are to be automatically cleared (non formulas only).
3. If I edit the name in a historical row of data, the cells to the right are to remain intact with no change.
In the most recently posted workbook, the code is accomplishing #1 and #2, but not #3. For whatever reason, the code seems to work as desired if I copy and paste it into a new workbook and enter dummy data.
Bob Phillips
03-24-2010, 04:46 PM
I see what you mean. I think this should work for you
Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "Name" '<== change to suit
On Error GoTo ws_exit
Application.EnableEvents = False
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target
If .Value2 = "" Then
If .Offset(1, 0).Value = "" Then
.Offset(0, 1).Value = ""
.Offset(0, 3).Value = "" 'Hours worked column
.Offset(0, 4).Value = "" 'Rate column
.Offset(0, 6).Value = "" 'Debit column
End If
ElseIf .Offset(0, 1).Value2 = "" Then
.Offset(0, 1).Value2 = Date
.Offset(0, 3).Value = 0 'Hours worked column
.Offset(0, 4).Value = Range("$E$2").Value 'Rate cell
.Offset(0, 6).Value = 0 'Debit column
End If
End With
End If
ws_exit:
Application.EnableEvents = True
End Sub
I see what you mean. I think this should work for you
Indeed, it does. Amazing stuff. Thanks again.
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.