Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > Slow code
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 440
Default Slow code
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
Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 3,290
Default Slow code
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
Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 440
Default Slow code
Thanks for the reply Jim, but that didn't make any difference. I am confused
because, if I comment out the line which puts the date in column B, it works
in a flash. If I comment out the time bit and put back the date, it takes 4
or 5 secs, so it's got to be something to do with the date part but I don't
know what!

Cheers,
--
Traa Dy Liooar

Jock


"Jim Cone" wrote:

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

Reply With QuoteReply With Quote
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 2,494
Default Slow code
not sure, but you can try turning off screenupdating and calculation
ad this to the beginning:

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

and this to the end:

Application.ScreenUpdating =True
Application.Calculation = xlCalculationAutomatic

--


Gary


"Jock" wrote in message
...
Thanks for the reply Jim, but that didn't make any difference. I am confused
because, if I comment out the line which puts the date in column B, it works
in a flash. If I comment out the time bit and put back the date, it takes 4
or 5 secs, so it's got to be something to do with the date part but I don't
know what!

Cheers,
--
Traa Dy Liooar

Jock


"Jim Cone" wrote:

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



Reply With QuoteReply With Quote
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 46
Default Slow code
It sounds like something you're doing is causing a recalc.

It's worth confirming that it is putting a date into column b, just setup a
test macro to just populate a date there & see what happens. Do you have
something in the formulae in the workbook that relies on a lot of processing
on column b in that sheet like a bunch of vlookups for example? That would
definitely do it.


"Jock" wrote:

Thanks for the reply Jim, but that didn't make any difference. I am confused
because, if I comment out the line which puts the date in column B, it works
in a flash. If I comment out the time bit and put back the date, it takes 4
or 5 secs, so it's got to be something to do with the date part but I don't
know what!

Cheers,
--
Traa Dy Liooar

Jock


"Jim Cone" wrote:

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

Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Hybrid Mode Hybrid Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
Slow Code thewizz Excel Programming 6 November 1st 07 06:41 PM
Slow code Sandy Excel Programming 2 August 21st 07 10:45 AM
Slow code when used as VBA code instead of macro (copying visible columns) [email protected] Excel Programming 3 April 2nd 07 05:26 PM
Slow Code Frank Kabel Excel Programming 1 July 23rd 04 09:28 AM
Is this slow code? Tom Excel Programming 4 March 3rd 04 11:18 PM


All times are GMT +1. The time now is 04:41 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement