Jock,
Remove or comment out all of the "Application.EnableEvents = True"
statements except for the very last one.

Also, add the following as the second line of your code...
On Error GoTo ws_exit
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware
(Excel Add-ins / Excel Programming)




"Jock"
wrote in message
I have looked in past posts but been unable to find something to speed up
this code.
The worksheet has a number of codes doing different things: entering date in
P when initials are put in O; putting everything in uppercase, for example.
The problem I have though seems to be with code which, when something is
entered in D, will automatically enter the date in B and the time in C. The
cell in B is also automatically coloured depending on the day of the week.
Although the time appears instantly, it then takes about 4 or 5 secs for
the date and colour to appear in B. In the status bar at the bottom, a
percentage bar trickles up during the 5 secs delay.

Rather than strip the code down to show just this, I have included the
whole thing as someone may have a solution.

Private Sub Worksheet_Change(ByVal Target As Range)

' Forces uppercase on selectes ranges
Application.EnableEvents = False
If Not Application.Intersect(Target,
Me.Range("D7:J5000,P7:Q5000,T7:U5000,X7:AA5000")) Is Nothing Then
Target(1).Value = StrConv(Target(1).Value, vbUpperCase)
End If
Application.EnableEvents = True


' Enters date & time automatically in B & C when text entered in D
On Error GoTo ws_exit:
Application.EnableEvents = False
If Not Intersect(Target, Me.Range("D7:D5000")) Is Nothing Then
With Target
If .Value < "" Then
.Offset(0, -1).Value = Format(Now, "hh:mm:ss")
Application.EnableEvents = True
.Offset(0, -2).Value = Format(Date, "dd/mmm")
End If
End With
End If

' Enters date automatically in R when text entered in Q
On Error GoTo ws_exit:
Application.EnableEvents = False
If Not Intersect(Target, Me.Range("Q7:Q5000")) Is Nothing Then
With Target
If .Value < "" Then
'.Offset(0, -1).Value = Format(Now, "hh:mm:ss")
Application.EnableEvents = True
.Offset(0, 1).Value = Format(Date, "dd/mmm")
End If
End With
End If

' Enters date automatically in V when text entered in U
On Error GoTo ws_exit:
Application.EnableEvents = False
If Not Intersect(Target, Me.Range("U7:U5000")) Is Nothing Then
With Target
If .Value < "" Then
'.Offset(0, -1).Value = Format(Now, "hh:mm:ss")
Application.EnableEvents = True
.Offset(0, 1).Value = Format(Date, "dd/mmm")
End If
End With
End If

' Colours column B depending on day of the week
If Not Intersect(Target, Me.Range("B7:B5000")) Is Nothing Then
With Target
Select Case Application.Weekday(.Value, 2)
Case 1: .Interior.ColorIndex = 15
Case 2: .Interior.ColorIndex = 45
Case 3: .Interior.ColorIndex = 38
Case 4: .Interior.ColorIndex = 50
Case 5: .Interior.ColorIndex = 44
End Select
End With
End If

ws_exit:
Application.EnableEvents = True
End Sub


Thanks for any replies
--
Traa Dy Liooar

Jock