Time stamp with undo funktion

[peter1601]

Hello

I'am using this code to generete a time stamp in my excel sheet. But
the cude also makes it impossible to use the undo bottom. Do any of
you have a trick to both have timestamp and undo funktion?

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
With Target
If .Count > 1 Then Exit Sub
If Not Intersect(Range("A2:A10"), .Cells) Is Nothing Then
Application.EnableEvents = False
If IsEmpty(.Value) Then
.Offset(0, 1).ClearContents
Else
With .Offset(0, 1)
.NumberFormat = "dd mmm yyyy hh:mm:ss"
.Value = Now
End With
End If
Application.EnableEvents = True
End If
End With
End Sub

 

[FSt1]

hi
vb code bybasses all of the built in niceities of excel such as multi levels
of undo.
so to have code and undo, you have to have more code to undo.
see this site.
http://spreadsheetpage.com/index.php/site/tip/undoing_a_vba_subroutine/

regards
FSt1

 

[peter1601]

hi
vb code bybasses all of the built in niceities of excel such as multi levels
ofundo.
so to have code andundo, you have to have more code toundo.
see this site.http://spreadsheetpage.com/index.php/site/tip/undoing_a_vba_subroutine/

regards
FSt1







- Vis tekst i anførselstegn -

Where do you type in the save range?

'Custom data type for undoing
Type SaveRange
Val As Variant
Addr As String
End Type

' Stores info about current selection
Public OldWorkbook As Workbook
Public OldSheet As Worksheet
Public OldSelection() As SaveRange


Sub ZeroRange()
' Inserts zero into all selected cells

' Abort if a range isn't selected
If TypeName(Selection) <> "Range" Then Exit Sub

' The next block of statements
' Save the current values for undoing
ReDim OldSelection(Selection.Count)
Set OldWorkbook = ActiveWorkbook
Set OldSheet = ActiveSheet
i = 0
For Each cell In Selection
i = i + 1
OldSelection(i).Addr = cell.Address
OldSelection(i).Val = cell.Formula
Next cell

' Insert 0 into current selection
Application.ScreenUpdating = False
Selection.Value = 0

' Specify the Undo Sub
Application.OnUndo "Undo the ZeroRange macro", "UndoZero"
End Sub


Sub UndoZero()
' Undoes the effect of the ZeroRange sub

' Tell user if a problem occurs
On Error GoTo Problem

Application.ScreenUpdating = False

' Make sure the correct workbook and sheet are active
OldWorkbook.Activate
OldSheet.Activate

' Restore the saved information
For i = 1 To UBound(OldSelection)
Range(OldSelection(i).Addr).Formula = OldSelection(i).Val
Next i
Exit Sub

' Error handler
Problem:
MsgBox "Can't undo"
End Sub