Undo a Worksheet_Change Event Causes run-time error '10'
 

Hello,
I have a spreadsheet that tracks scheduled and completed dates for
some tasks. These tasks are color formatted based on how the scheduled
dates relate to Today() or if the task has been completed. Since I
have more than three conditions (Excel 2003) I am applying the
conditional formatting with a Worksheet_Change Event. This wipes out
the Undo function.
Using John Walkenbach's code to 'Undo a VBA subroutine', I get a run-
time error '10' when I select Edit--Undo. Below are my code pieces.
Can anybody help, please? Any suggestions/solutions are greatly
appreciated.

Thanks so much.
Regards,
A. Crawford

=============================
Conditional Formatting
=============================

Private Sub Worksheet_Change(ByVal Target As Range)
Dim icolor As Integer

If Not Intersect(Target, Range("C3:I50")) Is Nothing Then
Select Case Target.Column
Case 3
If Target.Offset(0, 5).Value < Empty Then
icolor = 34
ElseIf Target.Offset(0, 5).Value = Empty Then
If Target < Date Then
icolor = 3
ElseIf Target = Date And Target <= Date + 7 Then
icolor = 4
ElseIf Target = Date And Target = Date + 7 And
Target <= Date + 14 Then
icolor = 27
Else
icolor = xlcolornone
End If
End If
Range(Target.Address, Target.Offset(0,
6).Address).Interior.ColorIndex = icolor
Case 8
If Target < Empty Then
icolor = 34
ElseIf Target = Empty Then
If Target < Date Then
icolor = 3
ElseIf Target = Date And Target <= Date + 7 Then
icolor = 4
ElseIf Target = Date And Target = Date + 7 And
Target <= Date + 14 Then
icolor = 27
Else
icolor = xlcolornone
End If
End If
Range(Target.Offset(0, 1).Address, Target.Offset(0,
-5).Address).Interior.ColorIndex = icolor
End Select
End If

Call Module1.Memo

End Sub

===========================
Undo modules
===========================

Type SaveRange
Val As Variant
Addr As String
End Type

Public OldWorkbook As Workbook
Public OldSheet As Worksheet
Public OldSelection() As SaveRange

Sub Memo()
If TypeName(Selection) < "Range" Then Exit Sub
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

Application.ScreenUpdating = False
Application.OnUndo "undo", "UndoZero"

End Sub

Sub UndoZero()
On Error GoTo Problem

Application.ScreenUpdating = False
OldWorkbook.Activate
OldSheet.Activate

For i = 1 To UBound(OldSelection)
Range(OldSelection(i).Addr).Formula = OldSelection(i).Val
Next i
Exit Sub

Problem:
MsgBox "Can't undo."
End Sub