Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations Chris Miller on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Assistance with Date & Time Stamp & Multiple Worksheets

Status
Not open for further replies.
Randy11

Randy11

Technical User
Oct 4, 2002
175
CA
Have a workbook that has multiple worksheets in it that are same design. Have two issues related to same code am looking for some assistance with.
1) The code below works well for generating date & time stamp.
There is one problem with the code. If an operator selects mutiple data entry cells & chooses delete. The date and time stamps do not clear as they should. if one cell is deleted works fine. Assistance with code appreciated.

2) With same code, am trying to apply worksheet_Change to many worksheets. Would like to set up one module with code in it & for each sheet simply Call The code in the Worksheet change. In this way when changes are made to the code it updates for all work sheets. If anyone is able to assist in altering code so this is possible & provide anything required in the worksheet change call code, would be appreciated.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

With Target
If .Count > 1 Then Exit Sub
If Not Intersect(Range("A29:A53"), .Cells) Is Nothing Then
Application.EnableEvents = False
If IsEmpty(.Value) Then
Cells(.Row, "F").ClearContents
Else
With Cells(.Row, "F")
NumberFormat = "dd mmm yyyy hh:mm:ss"
.Value = Now
End With
End If
Application.EnableEvents = True
End If
End With



With Target
If .Count > 1 Then Exit Sub
If Not Intersect(Range("b29:b53"), .Cells) Is Nothing Then
Application.EnableEvents = False
If IsEmpty(.Value) Then
Cells(.Row, "g").ClearContents
Else
With Cells(.Row, "g")
NumberFormat = "dd mmm yyyy hh:mm:ss"
.Value = Now
End With
End If
Application.EnableEvents = True
End If
End With



With Target
If .Count > 1 Then Exit Sub
If Not Intersect(Range("d29:d38"), .Cells) Is Nothing Then
Application.EnableEvents = False
If IsEmpty(.Value) Then
Cells(.Row, "h").ClearContents
Else
With Cells(.Row, "h")
NumberFormat = "dd mmm yyyy hh:mm:ss"
.Value = Now
End With
End If
Application.EnableEvents = True
End If
End With


With Target
If .Count > 1 Then Exit Sub
If Not Intersect(Range("d41:d45"), .Cells) Is Nothing Then
Application.EnableEvents = False
If IsEmpty(.Value) Then
Cells(.Row, "I").ClearContents
Else
With Cells(.Row, "I")
NumberFormat = "dd mmm yyyy hh:mm:ss"
.Value = Now
End With
End If
Application.EnableEvents = True
End If
End With
End Sub

 
Sort by date Sort by votes

hi,
If an operator selects mutiple data entry cells & chooses delete.
Click to expand...
Where is that code? Do not understand your question as it has no relevence to the posted code.

With respect to your second question, check out the Workbook_Sheet_Change event.

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Upvote 0 Downvote
Clarity re inquiry: If an operator selects mutiple data entry cells & chooses delete.....
Perhaps was not clear. Code is designed to drop a date & time stamp into a cells in a column to the right of where there is data entry of amounts.
The issue that am trying to address is if the operator chooses several cells where amounts were entered by highlighting with mouse & choose delete the date & time stamps do not disappear. If only one cell is deleted it works fine?
Thanks Skip for response on 2....
Purpose of all the code is to add the date & time stamp to allow for data from mutiple sheets to be appended into a single list in date & time order. If I had the option of using Access would not have this issue.
Further assistance appreciated.
 
Upvote 0 Downvote

if the operator chooses several cells where amounts were entered by highlighting with mouse & choose delete the date & time stamps do not disappear.
Click to expand...
What do you want to happen if the operator selects one or more ROWS and deletes the ROWS? There's no row to put anything in.

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Upvote 0 Downvote
The workbook is locked down except for the Data Entry feilds an operator keys in.
See 1st With Target Example
(Operator has access only to key into or delete info in the data entry cells A29:A53. Date & Time stamps are placed adjacent to these cells in Column f)

With Target
If .Count > 1 Then Exit Sub
If Not Intersect(Range("A29:A53"), .Cells)
Is Nothing Then
Application.EnableEvents = False
If IsEmpty(.Value) Then
Cells(.Row, "F").ClearContents
Else
With Cells(.Row, "F")
NumberFormat = "dd mmm yyyy hh:mm:ss".
Value = Now
etc etc
 
Upvote 0 Downvote


Code: 
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim t As Range
    For Each t In Target

        With t
            If Not Intersect(Range("A29:A53"), .Cells) Is Nothing Then
                Application.EnableEvents = False
                If IsEmpty(.Value) Then
                    Cells(.Row, "F").ClearContents
                Else
                    With Cells(.Row, "F")
                        NumberFormat = "dd mmm yyyy hh:mm:ss"
                        .Value = Now
                    End With
                End If
                Application.EnableEvents = True
            End If
        End With

'...... other with t statements

    Next
end sub

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Upvote 0 Downvote
Hey Skip, suspect I am missing something. Have completed the code & am getting significant number of errors. Have outlined as Red in 1st With t
Thanks Again, R

With t
Red            If Not Intersect(Range("A29:A53"), .Cells) Is Nothing Then
Red                Application.EnableEvents = False
                If IsEmpty(.Value) Then
Red                    Cells(.Row, "F").ClearContents
                Else
                    With Cells(.Row, "F")
                        NumberFormat = "dd mmm yyyy hh:mm:ss"
                        .Value = Now
Red                    End With
Red                End If
                Application.EnableEvents = True
Red            End If
Red        End With

'...... other with t statements

'    Next

'    Dim t As Range
'    For Each t In Target

         With t
            If Not Intersect(Range("b29:b53"), .Cells) Is Nothing Then
                Application.EnableEvents = False
                If IsEmpty(.Value) Then
                    Cells(.Row, "G").ClearContents
                Else
                    With Cells(.Row, "G")
                        NumberFormat = "dd mmm yyyy hh:mm:ss"
                        .Value = Now
                    End With
                End If
                Application.EnableEvents = True
            End If
        End With

'...... other with t statements

'    Next

'    Dim t As Range
'    For Each t In Target

        With t
            If Not Intersect(Range("d29:d38"), .Cells) Is Nothing Then
                Application.EnableEvents = False
                If IsEmpty(.Value) Then
                    Cells(.Row, "H").ClearContents
                Else
                    With Cells(.Row, "H")
                        NumberFormat = "dd mmm yyyy hh:mm:ss"
                        .Value = Now
                    End With
                End If
                Application.EnableEvents = True
            End If
        End With

'...... other with t statements

'    Next

'    Dim t As Range
'    For Each t In Target

        With t
            If Not Intersect(Range("d41:d45"), .Cells) Is Nothing Then
                Application.EnableEvents = False
                If IsEmpty(.Value) Then
                    Cells(.Row, "I").ClearContents
                Else
                    With Cells(.Row, "I")
                        NumberFormat = "dd mmm yyyy hh:mm:ss"
                        .Value = Now
                    End With
                End If
                Application.EnableEvents = True
            End If
        End With
 
End Sub
 
Upvote 0 Downvote
[red][highlight]
SAMPLE DATA PLEASE![/highlight][/red]

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Upvote 0 Downvote


Please COPY and PASTE here. Its the way its done here, by and large.

Your LINK references your C DRIVE!!!

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Upvote 0 Downvote
AA's AA's Time Stamps
$1.00 $1.00 30-Aug-2011 13:13:43 30-Aug-2011 13:14:40
$2.00 $1.00 30-Aug-2011 13:13:44 30-Aug-2011 13:14:41
$3.00 $1.00 30-Aug-2011 13:13:44 30-Aug-2011 13:14:41

This is A29:A31, B29:B31, F29:F31, G29:G31

Does this help?
 
Upvote 0 Downvote

this puts dates in delete or otherwose
Code: 
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim t As Range
    For Each t In Target

        With t
            If Not Intersect(Range("A29:A53"), .Cells) Is Nothing Then
                Application.EnableEvents = False
                If IsEmpty(.Value) Then
                    Cells(.Row, "F").ClearContents
                End If
                
                With Cells(.Row, "F")
                    .NumberFormat = "dd mmm yyyy hh:mm:ss"
                    .Value = Now
                End With
                Application.EnableEvents = True
            End If
        End With

'...... other with t statements

    Next
End Sub


Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Upvote 0 Downvote
Have completed & tested most recent code. Am getting "Next without for" VB error Message. Endif's look correct, should there not be a For in the code that works with the Next. Thanks...

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim t As Range
For Each t In Target

With t
If Not Intersect(Range("A29:A53"), .Cells) Is Nothing Then
Application.EnableEvents = False
If IsEmpty(.Value) Then
Cells(.Row, "F").ClearContents

End If
With Cells(.Row, "F")
.NumberFormat = "dd mmm yyyy hh:mm:ss"
.Value = Now
End With
Application.EnableEvents = True

End If
End With

'...... other with t statements

Next

With t
If Not Intersect(Range("b29:b53"), .Cells) Is Nothing Then
Application.EnableEvents = False
If IsEmpty(.Value) Then
Cells(.Row, "G").ClearContents

End If
With Cells(.Row, "F")
.NumberFormat = "dd mmm yyyy hh:mm:ss"
.Value = Now
End With
Application.EnableEvents = True

End If
End With

'...... other with t statements

Next

With t
If Not Intersect(Range("d29:d38"), .Cells) Is Nothing Then
Application.EnableEvents = False
If IsEmpty(.Value) Then
Cells(.Row, "H").ClearContents

End If
With Cells(.Row, "F")
.NumberFormat = "dd mmm yyyy hh:mm:ss"
.Value = Now
End With
Application.EnableEvents = True

End If
End With

'...... other with t statements

Next

With t
If Not Intersect(Range("d41:d45"), .Cells) Is Nothing Then
Application.EnableEvents = False
If IsEmpty(.Value) Then
Cells(.Row, "I").ClearContents

End If
With Cells(.Row, "F")
.NumberFormat = "dd mmm yyyy hh:mm:ss"
.Value = Now
End With
Application.EnableEvents = True

End If
End With

'...... other with t statements

Next

End Sub
 
Upvote 0 Downvote
oops, figured out wher I went wrong.

For Each t In Target - Missing in last 3 next scenarios.

This code as you point out replaces the date & time stamp when mutiple cells are selected for deletion. Am looking for the code to clear the Date & time stamp when mutiple cells deleted.

Have another way to prevent mutiple cell deletion but this is not very ideal.
Thanks for the education, further assistance appreciated.....
 
Upvote 0 Downvote

Code: 
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim t As Range
    For Each t In Target
    
        With t
            If Not Intersect(Range("A29:A53"), .Cells) Is Nothing Then
                Application.EnableEvents = False
                If IsEmpty(.Value) Then
                    Cells(.Row, "F").ClearContents

                End If
                With Cells(.Row, "F")
                    .NumberFormat = "dd mmm yyyy hh:mm:ss"
                    .Value = Now
                End With
                Application.EnableEvents = True
    
            End If
        End With

'...... other with t statements
        With t
            If Not Intersect(Range("b29:b53"), .Cells) Is Nothing Then
                Application.EnableEvents = False
                If IsEmpty(.Value) Then
                    Cells(.Row, "G").ClearContents

                End If
                With Cells(.Row, "F")
                    .NumberFormat = "dd mmm yyyy hh:mm:ss"
                    .Value = Now
                End With
                Application.EnableEvents = True
    
            End If
        End With

        With t
            If Not Intersect(Range("d29:d38"), .Cells) Is Nothing Then
                Application.EnableEvents = False
                If IsEmpty(.Value) Then
                    Cells(.Row, "H").ClearContents

                End If
                With Cells(.Row, "F")
                    .NumberFormat = "dd mmm yyyy hh:mm:ss"
                    .Value = Now
                End With
                Application.EnableEvents = True
    
            End If
        End With
    
        With t
            If Not Intersect(Range("d41:d45"), .Cells) Is Nothing Then
                Application.EnableEvents = False
                If IsEmpty(.Value) Then
                    Cells(.Row, "I").ClearContents

                End If
                With Cells(.Row, "F")
                    .NumberFormat = "dd mmm yyyy hh:mm:ss"
                    .Value = Now
                End With
                Application.EnableEvents = True
        
            End If
        End With
    Next
End Sub

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

K
  • Locked
  • Question
How to resolve define worksheets array
Replies
1
Views
581
combo
combo
remeng
  • Locked
  • Question
multiple err handling
Replies
6
Views
560
remeng
remeng
EliseFreedman
  • Locked
  • Question
booking tool - all day time slots
Replies
3
Views
536
Andrzejek
Andrzejek
remeng
  • Locked
  • Solved
Run-time error '429': ActiveX component can't create object From Excel to Word
Replies
9
Views
1K
remeng
remeng
arvarr
  • Locked
  • Question
Excel Help - Worksheets by UserID 3
2
Replies
39
Views
781
arvarr
arvarr

Part and Inventory Search

Sponsor

Back
Top