Worksheet change event using a button

Const PW As String = "Matt"
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim r As Long
    If Target.CountLarge > 1 Then Exit Sub
    ThisWorkbook.ActiveSheet.Unprotect PW
    If Not Intersect(Target, Range("C6:C" & Range("C" & Rows.Count).End(xlUp).Row)) Is Nothing Then
        r = Target.Row
        If Target <> "" Then
            Application.EnableEvents = False
            If Cells(r, "L") = "" Then
                Cells(r, "L").NumberFormat = "dd/mm/yyyy"
                Cells(r, "L") = Now
            End If
            Application.EnableEvents = True
        End If
    End If
    ThisWorkbook.ActiveSheet.Protect PW
Application.ScreenUpdating = True
End Sub

Select allOpen in new window

Const PW As String = "Matt"

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Long
Dim cell As Range
Application.ScreenUpdating = False
Application.EnableEvents = False
On Error GoTo Skip
ThisWorkbook.ActiveSheet.Unprotect PW
If Not Intersect(Target, Range("C6:C3000")) Is Nothing Then
    For Each cell In Target.Columns(1).Cells
        r = cell.Row
        If Cells(r, "C") <> "" Then
            If Cells(r, "L") = "" Then
                Cells(r, "L").NumberFormat = "dd/mm/yyyy"
                Cells(r, "L") = Now
            End If
        End If
    Next cell
ElseIf Not Intersect(Target, Range("AA6:AA3000")) Is Nothing Then
    If Target <> "" Then
        If LCase(Target.Value) = "completed" Then
            Target.EntireRow.Hidden = True
        End If
    End If
End If
ThisWorkbook.ActiveSheet.Protect PW
Skip:
Application.EnableEvents = True
End Sub

Select allOpen in new window

Const PW As String = "Matt"
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim r As Long
    If Target.CountLarge > 1 Then Exit Sub
    ThisWorkbook.ActiveSheet.Unprotect PW
    If Not Intersect(Target, Range("C6:C" & Range("C" & Rows.Count).End(xlUp).Row)) Is Nothing Then
        r = Target.Row
        If Target <> "" Then
            Application.EnableEvents = False
            If Cells(r, "L") = "" Then
                Cells(r, "L").NumberFormat = "dd/mm/yyyy"
                Cells(r, "L") = Now
            End If
            Application.EnableEvents = True
        End If
    End If
    Next cell
ElseIf Not Intersect(Target, Range("AA6:AA”& Range("AA" & Rows.Count).End(xlUp).Row)) Is Nothing Then
    If Target <> "" Then
        If LCase(Target.Value) = "completed" Then
            Target.EntireRow.Hidden = True
        End If
    End If
End If
ThisWorkbook.ActiveSheet.Protect PW
Application.ScreenUpdating = True
End Sub

Select allOpen in new window

Const PW As String = "Matt"
Sub AllocateTasks()
Dim swb As Workbook, dwb2 As Workbook
Dim sws As Worksheet, dws2 As Worksheet
Dim dwbPath As String, Team As String, TeamNo As String, Task As String
Dim lr As Long, i As Long

Application.ScreenUpdating = False

Set swb = ThisWorkbook
Set sws = swb.Sheets("Task Allocation")
lr = sws.Cells(Rows.Count, "N").End(xlUp).Row
If lr < 6 Then
    MsgBox "No Tasks were found to be allocated.", vbExclamation, "Tasks Not Found!"
    Exit Sub
End If

For i = lr To 6 Step -1
    If sws.Cells(i, "N").Value <> "" Then
        Task = sws.Cells(i, "N").Value
        TeamNo = ExtractNumber(Task)
        dwbPath = "C:\Secured\Planner Level\Planner " & TeamNo & "\Planner " & TeamNo & ".xlsm"
        On Error Resume Next
        Set dwb2 = Workbooks("Planner " & TeamNo & ".xlsm")
        On Error GoTo 0
    
        If dwb2 Is Nothing And Dir(dwbPath) <> "" Then
            Set dwb2 = Workbooks.Open(dwbPath, False)
        End If
        
        If Not dwb2 Is Nothing Then
            Set dws2 = dwb2.Sheets(1)
            dws2.Unprotect PW
            sws.Range("C" & i & ":K" & i).Copy
            dws2.Range("C" & Rows.Count).End(3)(2).PasteSpecial xlPasteAll
            sws.Range("C" & i & ":O" & i).Delete shift:=xlUp
        End If
    End If
Next i
dws2.Protect PW
End Sub

Select allOpen in new window