Marius Matei
Marius Matei

Reputation: 11

Private Sub Worksheet_Change(ByVal Target As Range) not working always

I am a beginner in VBA and I have an issue with a Private Sub Worksheet_Change code - it is not always working. I want when a cell in column A changes it's value to write on the same row in column B the Windows user who made the change.

Please see below my code, written in Sheet1, not in a Module:

Private Sub Worksheet_Change(ByVal Target As Range)

    Worksheets("Sheet1").Unprotect Password:=Password

    x = Target.Row         

    If Not Intersect(Target, Range("A" & x)) Is Nothing Then
        Range("B" & x).Value = Environ("USERNAME")
    End If

    Worksheets("Sheet1").Protect Password:=Password

End Sub

Upvotes: 1

Views: 2692

Answers (1)

Gary's Student
Gary's Student

Reputation: 96753

  1. first insure the cells in column A are un-locked. (coder)
  2. Create a password String variable. (code)
  3. Allow more than one cell to be changed (code)
  4. Prevent Event re-entry (code)

The first step should be done by the coder.


Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim x As Long, pswrd As String, cell As Range, inter As Range

    pswrd = "secret"
    Set inter = Intersect(Range("A:A"), Target)
    If inter Is Nothing Then Exit Sub
    
    Worksheets("Sheet1").Unprotect Password:=pswrd
    Application.EnableEvents = False
        For Each cell In inter
            x = cell.Row
            Range("B" & x).Value = Environ("USERNAME")
        Next cell
    Application.EnableEvents = True
    Worksheets("Sheet1").Protect Password:=pswrd

End Sub

EDIT#1:

Based on Darren Bartrup-Cook's suggestion, we can drop the loop:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim x As Long, pswrd As String, cell As Range, inter As Range

    pswrd = "secret"
    Set inter = Intersect(Range("A:A"), Target)
    If inter Is Nothing Then Exit Sub
    
    Worksheets("Sheet1").Unprotect Password:=pswrd
        Application.EnableEvents = False
            inter.Offset(0, 1).Value = Environ("USERNAME")
        Application.EnableEvents = True
    Worksheets("Sheet1").Protect Password:=pswrd

End Sub

Upvotes: 1

Related Questions