Time stamp with undo funktion




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


vb code bybasses all of the built in niceities of excel such as multi levels
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/


- 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

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

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

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question