Time to save a workbook

[serge]

Hi,

I have a shared workbook with several sheets that I use to scan in
badges from exhibitors (3 operators). After scanning i'm checking if
the number isn't already used.
If the check up is done, i save the workbook because then I can see the
changes made in the other sheets by other operators.
I never have had problems with saving the workbook as I went quickly.
But now I have to wait more then 6 seconds to scan in another badge.
I'm using at this moment Excel 2003 SP2 while previous I used Excel
2000.
Please, can somebody help me??
I have to use this program on saterday and I didn't found any answer
yet.

Thanks!
Serge


Code of 1 worksheet:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim scannummer As Variant
Dim teller As Variant
Dim timestamp As Date
Dim myrange As Range
Application.MoveAfterReturn = False

Set myrange = Intersect(Target, Range("E:E"))
If Not myrange Is Nothing Then
Sheets("scannummers").Visible = True
Sheets("details").Visible = True
Sheets("vooraan scan in").Select
scannummer = Range("E6")
If scannummer = "" Then
End If
If scannummer <> "" Then
Sheets("scannummers").Select
Sheets("Scannummers").Range("a:a").Cells.Find(what :=scannummer, _
LookIn:=xlFormulas, _
MatchCase:=False).Activate
teller = ActiveCell.Offset(0, 1).Formula
teller = teller + 1
ActiveCell.Offset(0, 1).Formula = teller
If teller = 2 Then
teller = 1
ActiveCell.Offset(0, 1).Formula = teller
Sheets("vooraan scan in").Activate
Cells.Select
With Selection.Interior
..ColorIndex = 3
..Pattern = xlSolid
End With
Beep
Application.Wait Now + TimeValue("00:00:01")
Beep

MsgBox "Tweede maal binnengekomen", vbOKOnly
Cells.Select
With Selection.Interior
..ColorIndex = 8
..Pattern = xlSolid
End With
Range("D4:F5").Select
With Selection.Interior
..ColorIndex = 2
..Pattern = xlSolid
End With
Range("d7:f9").Select
Selection.Interior.ColorIndex = 2
Range("D56").Select
Selection.Interior.ColorIndex = 2
Range("F5:F6").Select
Selection.Interior.ColorIndex = 2
ElseIf teller = 3 Then
Sheets("vooraan scan in").Activate
MsgBox "Doorverwijzen, 3e keer !", vbOKOnly
ElseIf teller >= 4 Then
Sheets("vooraan scan in").Activate
MsgBox teller & "e keer, ONTOELAATBAAR !!!", vbCritical, vbOKOnly
ElseIf teller = -1 Then
teller = 0
ActiveCell.Offset(0, 1).Formula = teller
Sheets("vooraan scan in").Activate
MsgBox "Meer buitengegaan dan binnengekomen", vbOKOnly

End If
Sheets("details").Select
Sheets("details").Range("a65536").End(xlUp).Offset (1, 0).Activate
ActiveCell = scannummer
timestamp = Format(Now(), "d/mm/yyyy hh:mm:ss")
ActiveCell.Offset(0, 1).Formula = timestamp
ActiveCell.Offset(0, 2).Value = "IN"
Sheets("vooraan scan in").Select
Sheets("vooraan scan in").Range("E6").Select
ActiveWorkbook.Save
Sheets("scannummers").Visible = False
Sheets("details").Visible = False


End If

ElseIf Range("G6") <> "" Then

Set myrange = Intersect(Target, Range("G:G"))
If Not myrange Is Nothing Then
scannummer = Range("G6")
Sheets("scannummers").Visible = True
Sheets("details").Visible = True
If scannummer = "" Then
End If
If scannummer <> "" Then
Sheets("scannummers").Select
Sheets("scannummers").Range("a:a").Cells.Find(what :=scannummer, _
LookIn:=xlFormulas, _
MatchCase:=False).Activate
teller = ActiveCell.Offset(0, 1).Formula
teller = teller - 1
ActiveCell.Offset(0, 1).Formula = teller
If teller = -1 Then
teller = 0
ActiveCell.Offset(0, 1).Formula = teller
Sheets("vooraan").Activate
MsgBox "Meer buitengegaan dan binnengekomen", vbOKOnly

Else
End If
Sheets("details").Select
Sheets("details").Range("a65536").End(xlUp).Offset (1, 0).Activate
ActiveCell = scannummer
timestamp = Format(Now(), "d/mm/yyyy hh:mm:ss")
ActiveCell.Offset(0, 1).Formula = timestamp
ActiveCell.Offset(0, 2).Value = "OUT"
Sheets("vooraan").Select

ActiveWorkbook.Save
Sheets("vooraan").Range("E6").Select
Selection.Interior.ColorIndex = xlNone
Sheets("vooraan").Range("g6").Select
Selection.Interior.ColorIndex = 8
Sheets("scannummers").Visible = False
Sheets("details").Visible = False
End If



End If
End If
End Sub

 

[NickHK]

serge,
Didn't examine your code too closely and can't say about any difference
between XL2000 and XL2003, but a few thing spring to mind to speed thing up.

You can get rid of all the .Selects and .Activates., until you actually want
to bring a cell to the attention of the user.
Also, a minor point, but don't use variants unless you require that ability.

Whilst I assume this works, what is the value of "scannummer" ?
Dim scannummer As Variant 'Dim scannummer As String
scannummer = Range("E6") 'scannummer = Range("E6").Value
because later you test scannummer <> ""

Also with:
Dim teller As Variant Dim teller As Long
teller = teller + 1

And, do you need to work with every cell on the WS ?
e.g. Cells.Select


NickHK

 

[serge]

Hi Nick,

I' ve changed a few things but the problem stays the same. The progra
works perfect if I drop the line activeworkbook.save
I never have had the problem before and i didn't change anything on th
program before.

Serg