Solved: Worksheet_Change Question

[Opv]

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]

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]

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

[Opv]

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]

[Opv]

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]

Run this macro

Sub Enables
Application.EnableEvents = True
End Sub

[Bob Phillips]

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

[Opv]

Run this macro

Sub Enables
Application.EnableEvents = True
End Sub



Thanks. That got me back to detecting changes.

Opv

[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

[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]

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.

[Opv]

Me refers to the containing object, the worksheet in this case, so it is a range within the worksheet.

Thanks. Works great.

[Opv]

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]

I cannot reporduce that. Can you give more details?

[Opv]

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]

Can you post the offending workbook with the modified code?

[Opv]

Can you post the offending workbook with the modified code?
Here is a sample.

Thanks,

Opv

[Bob Phillips]

I can't see anything untoward happening. Can you talk me through the problem?

[Opv]

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]

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

[Opv]

I see what you mean. I think this should work for you



Indeed, it does. Amazing stuff. Thanks again.