Takes long to save the file (Speed problem)

[cskgg]

Hi all,

I have had some excellent help from this forum. 3 cheers!!

I am having SPEED probelm. I have written the following code (to chec
a Work Order number in column-B and find if Account code has bee
entered in the column-J (500 lines).

Problem is, when the user tries to SAVE the file, it takes a fe
seconds (about 5-6 seconds). Hardware is OK. It takes a long time t
save on slow as well as faster PCs. The users are screaming and
almost had a fight with one of the users.

Any HELP ???

Tks
CSKGG


Dim choice As Integer
Dim choice2 As Integer
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, _
Cancel As Boolean)
With Application
.Calculation = xlManual
.ScreenUpdating = False
.DisplayAlerts = False
End With

ActiveWorkbook.Worksheets(1).Select
For N = 500 To 3 Step -1

If Cells(N, 2) <> "" And Cells(N, 10) = "" Then GoT
line1
Cells(N, 2).Select
Next N
ThisWorkbook.Save
MsgBox ("Account Codes are Present" & Chr(13) & "You
changes are being saved!")
End

line1:
choice = MsgBox("You have not entered the ACCOUNT CODE" & Chr(13
& "You cannot save this workbook. Do you wish" & Chr(13) & "to save th
file without the account code?", vbYesNoCancel + vbCritical)
msg = ("Do you still wish to save the file ?" & vbOKCancel)
If choice = vbCancel Then End
If choice = vbNo Then
choice2 = MsgBox(" Your Changes have NOT been saved!"
Chr(13) & "Do you wish to close this file without saving?", vbYesNo
vbCritical)
If choice2 = vbNo Then End
If choice2 = vbYes Then
ThisWorkbook.Close False
Cells(N, 10).Select
Application.ThisWorkbook.Close
End If
End If
End
With Application
.Calculation = xlAutomatic
.ScreenUpdating = True
.DisplayAlerts = True
End With



End Su