Vba speed up my code!

[DaveR]

I have the following vba which simply tracks what users of the database do (For auditing reasons)

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal target As Range)
Dim LR As Long
If Sh.Name = "Variations" Then Exit Sub
Application.EnableEvents = False

 Application.ScreenUpdating = False 'turn off screen updating to speed things up

With Sheets("Variations")
    'Unprotect sheet
    .Unprotect "xxx"
    
     LR = .Range("A" & Rows.Count).End(xlUp).Row
    .Range("A" & LR + 1).Value = Now
    .Range("B" & LR + 1).Value = Sh.Name
    .Range("C" & LR + 1).NumberFormat = "@"
    .Range("C" & LR + 1).Value = target.Address(False, False)
    .Range("D" & LR + 1).Value = target.Value
    .Range("E" & LR + 1).Value = Environ("username")

    
    'Protect the sheet again
    .Protect "xxx"
    
     Application.ScreenUpdating = True 'turn on screen updating

End With
Application.EnableEvents = True
End Sub

However, if I add a new line to a worksheet (quite a common event!), the routine takes an age to process this.

Is there a quicker way to do this?

 

[jim may]

Not sure I'm getting this right, or not -- but you have the code line:

If Sh.Name = "Variations" Then Exit Sub

3 code lines later you have the code line:

With Sheets("Variations")
.............
End With

Seems like the 1st Statement - EXITED YOU from the Macro - so Excel is Never going to see the 2nd Code line(s)......

Confused...

 

[ISY]

Hello

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal target As Range)
    Dim LR As Long
    If Sh.Name = "Variations" Then Exit Sub
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    With Sheets("Variations")
        'Unprotect sheet
        '.Unprotect "xxx"
        LR = .Cells(Rows.Count, 1).End(xlUp).Row + 1
        .Cells(LR, 1) = Now
        .Cells(LR, 2) = Sh.Name
        .Cells(LR, 3).NumberFormat = "@"
        .Cells(LR, 3) = target.Address(False, False)
        .Cells(LR, 4) = target.Value
        .Cells(LR, 5) = Environ("username")
        'Protect the sheet again
        '.Protect "xxx"
    End With
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
End Sub

Try to hide the paper 'Variations' with
Alt F11
F4
Visible

Excel 2003

 

[Andrew Poulsom]

By "add a new line" do you mean if you insert a row?

@Jim - Variations is the sheet on which the changes are logged. The second line exits the procedure if something on that sheet is changed. Changes on all other sheets are logged.

 

[jim may]

Ugh!!

 

[DaveR]

Yes, I mean adding in a new row.

For the purposes of the auditing, I don't need to record this really as when the data is entered, this will be added anyway.

 

[Andrew Poulsom]

Try:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim LR As Long
    If Sh.Name = "Variations" Then Exit Sub
    If Target.Address = Target.EntireRow.Address Then Exit Sub
    Application.EnableEvents = False
    Application.ScreenUpdating = False 'turn off screen updating to speed things up
    With Sheets("Variations")
'       Unprotect sheet
        .Unprotect "xxx"
         LR = .Range("A" & Rows.Count).End(xlUp).Row
        .Range("A" & LR + 1).Value = Now
        .Range("B" & LR + 1).Value = Sh.Name
        .Range("C" & LR + 1).NumberFormat = "@"
        .Range("C" & LR + 1).Value = Target.Address(False, False)
        .Range("D" & LR + 1).Value = Target.Value
        .Range("E" & LR + 1).Value = Environ("username")
'       Protect the sheet again
        .Protect "xxx"
        Application.ScreenUpdating = True 'turn on screen updating
    End With
    Application.EnableEvents = True
End Sub

 

[DaveR]

Just tried it, still taking 40 seconds to loop through to completion.

Perhaps it would be quicker simply to trap the new row and not record it?

 

[Andrew Poulsom]

That does trap the insertion of a row and doesn't record it. Something else must be taking time.

 

[DaveR]

I'm not sure it is doing it correctly as the 'Variations' sheet still shows that 63 changes have been made......