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?

 

[Andrew Poulsom]

What sort of changes?

 

[DaveR]

It does this....

3/17/2011	Data Input	B125	Inactive	drignall
3/17/2011	Data Input	E125	111	drignall
3/17/2011	Data Input	J125	16+	drignall
3/17/2011	Data Input	K125	18+	drignall
3/17/2011	Data Input	Q125	 - 	drignall
3/17/2011	Data Input	U125	0	drignall
3/17/2011	Data Input	V125	Already left placement	drignall
3/17/2011	Data Input	AA125	1	drignall
3/17/2011	Data Input	AB125	1	drignall
3/17/2011	Data Input	AC125	1	drignall
3/17/2011	Data Input	AD125	1	drignall
3/17/2011	Data Input	AE125	1	drignall
3/17/2011	Data Input	AF125	1	drignall
3/17/2011	Data Input	AH125	£0.00	drignall
3/17/2011	Data Input	AI125	£0.00	drignall
3/17/2011	Data Input	AJ125	£0.00	drignall
3/17/2011	Data Input	AK125	£0.00	drignall
3/17/2011	Data Input	AL125	£0.00	drignall
3/17/2011	Data Input	AM125	£0.00	drignall
3/17/2011	Data Input	AN125	£0.00	drignall
3/17/2011	Data Input	AO125	£0.00	drignall
3/17/2011	Data Input	AP125	£0.00	drignall
3/17/2011	Data Input	AQ125	£0.00	drignall
3/17/2011	Data Input	AR125	£0.00	drignall
3/17/2011	Data Input	AS125	#REF!	drignall
3/17/2011	Data Input	AT125	#REF!	drignall
3/17/2011	Data Input	AU125	#REF!	drignall
3/17/2011	Data Input	AV125	#REF!	drignall
3/17/2011	Data Input	AW125	#REF!	drignall
3/17/2011	Data Input	AX125	#REF!	drignall
3/17/2011	Data Input	AY125	#REF!	drignall
3/17/2011	Data Input	AZ125	#REF!	drignall
3/17/2011	Data Input	BA125	#REF!	drignall
3/17/2011	Data Input	BB125	#REF!	drignall
3/17/2011	Data Input	BC125	#REF!	drignall
3/17/2011	Data Input	BD125	#REF!	drignall
3/17/2011	Data Input	BE125	#REF!	drignall
3/17/2011	Data Input	BF125	#REF!	drignall
3/17/2011	Data Input	BG125	#REF!	drignall
3/17/2011	Data Input	BH125	#REF!	drignall
3/17/2011	Data Input	BI125	#REF!	drignall
3/17/2011	Data Input	BJ125	#REF!	drignall
3/17/2011	Data Input	BK125	#REF!	drignall
3/17/2011	Data Input	BL125	#REF!	drignall
3/17/2011	Data Input	BM125	#REF!	drignall
3/17/2011	Data Input	BN125	#REF!	drignall
3/17/2011	Data Input	BO125	#REF!	drignall
3/17/2011	Data Input	BP125	#REF!	drignall
3/17/2011	Data Input	BQ125	#REF!	drignall
3/17/2011	Data Input	BR125	#REF!	drignall
3/17/2011	Data Input	BS125	£0.00	drignall
3/17/2011	Data Input	BT125	£0.00	drignall
3/17/2011	Data Input	BU125	£0.00	drignall
3/17/2011	Data Input	BV125	£0.00	drignall
3/17/2011	Data Input	BW125	£0.00	drignall
3/17/2011	Data Input	BX125	£0.00	drignall
3/17/2011	Data Input	BY125	£0.00	drignall
3/17/2011	Data Input	BZ125	£0.00	drignall
3/17/2011	Data Input	CA125	£0.00	drignall
3/17/2011	Data Input	CB125	£0.00	drignall
3/17/2011	Data Input	CC125	£0.00	drignall
3/17/2011	Data Input	CD125	£0.00	drignall

and makes me wait 40sec for the pleaseure!

 

[Andrew Poulsom]

What is causing those cells to be changed when you insert a row?

 

[DaveR]

The sheet which is generally used; 'Data Input' appears to pre-populates those cells automatically.

I think this is because it is populating it from a drop down menu/list (on another sheet, not done via vba!)

Sorry for the vagueness, it's not my database, just something I have inherited!

 

[Andrew Poulsom]

Sorry, I can't help you if you can't tell me what is causing those cells to change.

 

[Norie]

How can a dropdown automatically populate a range without there being some code?

If there is a linked cell then it might populate that but even if you set the linked cell to be a range it will only populate one cell as far as I know.

 

[DaveR]

On looking through it, it appears that the cells are populated as the sheet is using an Excel table........


Happy to email a copy(PM an email address), if it would help to see how it is behaving.

 

[Andrew Poulsom]

Check your PMs.

 

[DaveR]

I have posted something to you.

 

[DaveR]

After some heroic work from Andrew Poulson, I can confirm that the issue of the code not working is because Excel 2007 and Excel 2010 appear to be incompatable....

Although the code works beautifully in Excel 2010, if fails miserably in 2007. Thanks Microsoft!

To remedy the issue the following code has been inserted to fix it

If IsEmpty(Sh.Range("A" & target.Row)) Then Exit Sub

Again, thanks to Andrew for his help in the matter (and to confirm that my experience in Excel 2007 were replicable, and I wasn't going mad)