VBA code run error/add row locking

[johnaskme]

I am current running the code below, to auto populate dates into column A when someone puts their initials into column B. If someone drags their initials to cover more then one block it is giving error 13. I am unsure how to fix this error. I am also trying to find a way to add into the code, that once the person the initials into column B, it locks the Row from A-G. So example Joe Smith, initials B2-B5, it auto dates A2-A5 and locks all rows from A2 to G5. If i can please get help adding that code, and fixing the error 13.
Dim PreviousValue
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cell As Range
For Each Cell In Target
If Cell.Column = Range("B:B").Column Then
If Cell.Value <> "" Then
Cells(Cell.Row, "A").Value = Now
Else
Cells(Cell.Row, "A").Value = ""
End If
End If
Next Cell
Dim PreviousValue

Dim i As Long
Dim ws As Worksheet

Set ws = Sheets("log")

i = ws.Range("A" & Rows.Count).End(xlUp).Row + 1

If Target.Value <> PreviousValue Then
With ws
.Range("A" & i).Value = Application.UserName
.Range("B" & i).Value = Target.Address
.Range("C" & i).Value = PreviousValue
.Range("D" & i).Value = Target.Value
.Range("E" & i).Value = Format(Now(), "dd/mm/yyyy")
End With
End If

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
PreviousValue = Target.Value
End Sub

 

[johnaskme]

Dim PreviousValue

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Cell As Range

For Each Cell In Target

    If Cell.Column = Range("B:B").Column Then

        If Cell.Value <> "" Then

            Cells(Cell.Row, "A").Value = Now

        Else

            Cells(Cell.Row, "A").Value = ""

        End If

    End If

Next Cell

Dim PreviousValue


Dim i As Long

Dim ws As Worksheet


Set ws = Sheets("log")


i = ws.Range("A" & Rows.Count).End(xlUp).Row + 1


If Target.Value <> PreviousValue Then

    With ws

        .Range("A" & i).Value = Application.UserName

        .Range("B" & i).Value = Target.Address

        .Range("C" & i).Value = PreviousValue

        .Range("D" & i).Value = Target.Value

        .Range("E" & i).Value = Format(Now(), "dd/mm/yyyy")

    End With

End If


End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)

   PreviousValue = Target.Value

End Sub

 

[Alex Blakenburg]

You are getting an error when Multiple cells are changed because the line below doesn't work when Target is more than one cell.

If Target.Value <> PreviousValue Then

In a copy of your workbook try the below:
I am not 100% sure it will log everything you are intending to log but I think it logs what you are currently logging being a change of initials.

1) In a standard module ie Under the Modules node in the Project Window paste the below:
(Maybe give the module a clear name so you know where you have put this)

Public arrPrevious() As Variant

2) In your worksheet module, replace what you have there with this:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rCell As Range
    Dim rInit As Range
    
    Set rInit = Intersect(Target, Columns("B"))
    If rInit Is Nothing Then Exit Sub
    
    Application.EnableEvents = False
    
    Dim iLog As Long
    Dim jArr As Long
    
    Dim ws As Worksheet
    Set ws = Sheets("log")
    iLog = ws.Range("A" & Rows.Count).End(xlUp).Row + 1
    
    For Each rCell In rInit
        jArr = jArr + 1
        If rCell.Value <> "" Then
            Cells(rCell.Row, "A").Value = Now
        Else
            Cells(rCell.Row, "A").Value = ""
        End If
        
        If rCell.Value <> arrPrevious(jArr, 1) Then
            With ws
                .Range("A" & iLog).Value = Application.UserName
                .Range("B" & iLog).Value = rCell.Address
                .Range("C" & iLog).Value = arrPrevious(jArr, 1)
                .Range("D" & iLog).Value = rCell.Value
                .Range("E" & iLog).Value = Format(Now(), "dd/mm/yyyy")
            End With
            iLog = iLog + 1
        End If
    Next rCell
    
    Application.EnableEvents = True

End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim rInit As Range
    Dim arrTemp As Variant

    Set rInit = Intersect(Target, Columns("B"))
    If rInit Is Nothing Then Exit Sub
    arrTemp = rInit.Value
    If Not IsArray(arrTemp) Then
        ReDim arrTemp(1 To 1, 1 To 1)
        arrTemp(1, 1) = rInit.Value
    End If
    
    arrPrevious = arrTemp

End Sub