Hi All,

Hope all is well.

Intermediate VBA writer here looking for some fine tuning on my Event Change code if anyone would be willing?

Unfortunately the code seems to make data entry in the worksheet slower - 1-2 seconds between inputting.

The code is meant to keep an audit trail of changes to two specific columns and check for duplicates between these columns on the same row.

Private Sub Worksheet_Change(ByVal Target As Range)

On Error GoTo errorhandler

Dim ws As Worksheet
Dim c As Range

    If Not Application.Intersect(Target, Columns(1)) Is Nothing Then
        ThisWorkbook.Sheets("DATA").Unprotect Password:="PASS123"
        Application.Calculation = xlCalculationManual
        Application.EnableEvents = False
        Application.ScreenUpdating = False
        For Each c In Target
            If c.Value = "" Then
                c.Offset(0, 3).Value = ""
                c.Offset(0, 4).Value = ""
            Else
                If c.Value = c.Offset(0, 5).Value Then
                    MsgBox "authorisation(s) duplicated."
                    c.Value = ""
                    c.Offset(0, 3).Value = ""
                    c.Offset(0, 4).Value = ""
                Else
                    c.Offset(0, 3).Value = UCase(Environ("USERNAME"))
                    c.Offset(0, 4).Value = Format(Now, "YYYYMMDD HHMMSS")
                End If
            End If
        Next c
        ThisWorkbook.Sheets("DATA").Protect Password:="PASS123", AllowFiltering:=True
        Application.Calculation = xlCalculationAutomatic
        Application.EnableEvents = True
        Application.ScreenUpdating = True
    End If
    If Not Application.Intersect(Target, Columns(5)) Is Nothing Then
        ThisWorkbook.Sheets("DATA").Unprotect Password:="PASS123"
        Application.Calculation = xlCalculationManual
        Application.EnableEvents = False
        Application.ScreenUpdating = False
        For Each c In Target
            If c.Value = "" Then
                c.Offset(0, 3).Value = ""
                c.Offset(0, 4).Value = ""
            Else
                If c.Value = c.Offset(0, -5).Value Then
                    MsgBox "authorisation(s) duplicated."
                    c.Value = ""
                    c.Offset(0, 3).Value = ""
                    c.Offset(0, 4).Value = ""
                Else
                    c.Offset(0, 3).Value = UCase(Environ("USERNAME"))
                    c.Offset(0, 4).Value = Format(Now, "YYYYMMDD HHMMSS")
                End If
            End If
        Next c
        ThisWorkbook.Sheets("DATA").Protect Password:="PASS123", AllowFiltering:=True
        Application.Calculation = xlCalculationAutomatic
        Application.EnableEvents = True
        Application.ScreenUpdating = True
    End If
    Exit Sub

errorhandler:
    ThisWorkbook.Sheets("DATA").Protect Password:="PASS123", AllowFiltering:=True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    MsgBox ("An error has been detected. The macro will now exit.")
 
End sub

A general question as well please - can you code an Event Change macro to only run if certain cells are changed in a worksheet rather than any cell - another approach to eliminate the issue!


Many thanks in advance for any advice - and Merry Christmas all!