my worksheet change even keeps stopping for range (B10:B47). I added "Application.EnableEvents = True" into my code but it still stops. When it stops I run the below code with that in it and it works again. Do I have it placed into my first code correctly or what need to be changed
Private Sub Worksheet_Change(ByVal Target As Range)
'On Error GoTo ErrorHandler
Dim EndTime As Range
Dim SBlank As String
SBlank = """" & """"
Set EndTime = Range("B10:B47")
'ActiveSheet.Protect Password:="Financial1", UserInterFaceOnly:=True
ActiveSheet.Protect , UserInterFaceOnly:=True
Application.EnableEvents = True
If Target.Column <> 2 Or Target.Count > 1 Or Target.Row < 10 Or Target.Row > 47 Then Exit Sub
If Not Application.Intersect(EndTime, Range(Target.Address)) Is Nothing Then
If Target.Value = "" Then
Target.Offset(1, -1).Value = ""
GoTo 99
End If
'If TimeValue(Format(Target.Value, "hh:mm")) <> "12:00:00 AM" Then
'Target.Offset(1, -1).Value = "=IF(ISBLANK(B" & Target.Row & ")," & SBlank & ",B" & Target.Row & ")"
'End If
If Intersect(Target, Range("B10:B47")) Is Nothing Then Exit Sub
Dim xHour As String
Dim xMinute As String
Dim xWord As String
Application.EnableEvents = False
xWord = Format(Target.Value, "0000")
xHour = Left(xWord, 2)
xMinute = Right(xWord, 2)
On Error Resume Next
Target.Value = TimeValue(xHour & ":" & xMinute)
On Error Resume Next
Application.EnableEvents = True
If TimeValue(Format(Target.Value, "hh:mm")) <> "12:00:00 AM" Then
Target.Offset(1, -1).Value = "=IF(ISBLANK(B" & Target.Row & ")," & SBlank & ",B" & Target.Row & ")"
End If
End If
Application.EnableEvents = True
'ErrorHandler:
'Resume Next
'Application.EnableEvents = True
99:
End Sub
when I run this it starts to work again
Sub Restart()
Application.EnableEvents = True
End Sub
Bookmarks