Help - old code inherited with project

[Sandy]

Hello -

I have the following code in a rather complex project that was done by a
previous developer. I have to admit, I don't quite understand the code or
why it was done this way, but it seems to work, except when I try to add
extra functionality to it. Also, it works extremely slowly, probably from
the references to time. I don't understand why it was included.

This code was designed to change the designated range to "N/A" when a
specific answer was given in the Triggered By column. Anyway, here's the
code and the sheet to which it refers:

Sub auto_open()
' Run the macro DidCellsChange any time a entry is made in a cell in
Sheet1.
ThisWorkbook.Worksheets("DIV").OnEntry = "DidCellsChange"
End Sub

Sub DidCellsChange()
Dim KeyCells As String
'Define which cells should trigger the KeyCellsChanged macro.
KeyCells = "D839, D40117, D119350" '"D837, D40117, D119200"
'KeyCells = "A1:A10, B1:B10, C1:C10"

' If the Activecell is one of the key cells, call the KeyCellsChanged
macro.
If Not Application.Intersect(ActiveCell, Range(KeyCells)) _
Is Nothing Then KeyCellsChanged

End Sub

Sub KeyCellsChanged()
Dim Msg, Style, Title, Response, MyString 'Help, Ctxt,
Dim aValues As Variant, bGoodValue As Boolean, nCtr As Integer
Dim KeyEventFill As Variant

KeyEventFill = "D9,D35: D36,D39,D60,D69: D74,D85,D89,D96: D98, D100:
D104,D114: D117,D131: D132,D132,D141: D152,D158: D167,D178: D183 , D185:
D194,D199: D201"
aValues = Array("Yes", "No", "N/A")
bGoodValue = False

Msg = "You have made an invalid entry into Cell: " &
ActiveCell.Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
". Valid entries are:" & _
" (Yes, No, or N/A)" & Chr(10) & Chr(13) & "You Entered: " &
ActiveCell.Value & _
Chr(10) & Chr(13) & "The Invalid Entry is deleted."
Style = vbCritical
Title = "Invalid Entry Notification!" ' Define title.

For Each Element In aValues
'If UCase(ActiveCell.Value) = UCase(Element) Then
If (ActiveCell.Value = Element) Then
bGoodValue = True
Exit For
End If
Next Element
Sheet23.Unprotect ("pwd411")
If Not bGoodValue Then
Response = MsgBox(Msg, Style, Title) ', Help, Ctxt)
ActiveCell.Value = ""
ThisWorkbook.Worksheets("WorkFile").Range("A2").Value =
ActiveCell.Address(RowAbsolute, ColumnAbsolute)
Application.OnTime _
EarliestTime:=Now + TimeValue("00:00:01"), _
Procedure:="TrapTime"
Exit Sub
Sheet23.Protect ("pwd411")
Else 'valid data was entered into the cell.
'process autofills where necessary
UpdateCells
End If

End Sub

Sub UpdateCells()
Dim iCtr As Integer
iCtr = 1
Sheet23.Unprotect ("pwd411")
With ThisWorkbook.Worksheets("WorkFile")

iCtr = 1
For Each cell In .Range("B2:B17")
iCtr = iCtr + 1
If (cell = ActiveCell.Address(RowAbsolute, ColumnAbsolute)) Then

'If (Trim(ActiveCell.Value) = Trim(.Range("D" &
iCtr).Value)) Then
If (InStr(1, UCase(Trim(.Range("D" & iCtr).Value)),
UCase(Trim(ActiveCell.Value))) <> 0) Then
Range(.Range("C" & iCtr).Value).Value = "N/A"

'set focus to this address after one second
ThisWorkbook.Worksheets("WorkFile").Range("A2").Value =
..Range("E" & iCtr).Value
Application.OnTime _
EarliestTime:=Now + TimeValue("00:00:01"), _
Procedure:="TrapTime"
Else
Range(.Range("C" & iCtr).Value).Value = ""
End If

Exit For
End If
Next cell
End With
Sheet23.Protect ("pwd411")
End Sub

Sub TrapTime()
Range(ThisWorkbook.Worksheets("WorkFile").Range("A2").Value).Activate
End Sub
********************************
This is the sheet called "WorkFile" that the above code refers to after
finding if the cell changed in Worksheet “DIV†and D8 in Active Cell below is
Cell A2 on the "WorkFile"

A B C D E
Active Control AutoFill Ranges Triggered Pass Control
Cell Cell By Here
________________________________________________________________
D8 D8 D9 Yes D10
D37 D3839 No D40
D37 D4042 Yes D38
D59 D60 Yes D61
D68 D6973 No D74
D83 D85 No D86
D88 D89 N/A D90
D102 D103105,D107111 No D112
D123 D124126 No D127
D154 D155156 No D158
D155 D156 No D158
D167 D168170,D172174 Yes D187
D187 D188189,D191197 N/A D212
D212 D214218,D221230 No D237
D237 D238240 No D241

NOTE: D37 doesn't always work.

1.) I need the ability to change the AutoFill Ranges to blank if the
Control Cell is blank.
2.) I need to speed up the process.
3.) I get unpredictable results; particularly with Cell D37
4.) Is there any particular reason to have the time stuff in here? What
can I take out that may speed it up?

ANY suggestions at all will be greatly appreciated!!!

Sandy