VBA code for additional worksheet protections

[BeachDog_2600]

I am trying to add additional protections to a workbook that multiple users use and some of those users are not that great with technology. I'm running into an issue by using workbook/worksheet protections because I need everyone to be able to input data, but the inexperienced users are screwing up the worksheet by copying and pasting cells that have data validation drop downs and tooltips. I'm noticing that errors keep happening even after trying to help those users understand, but I'm thinking that improving the workbook with VBA code might be the best solution. I'm not very familiar with VBA code, but I'm taking some classes on LinkedIn learning to become more familiar (any suggestions on other resources for learning would be much appreciated.)

What I'm trying to do is create a VBA code that does the following:

1. When the workbook is opened, I want the data to automatically sort the table (columns A-AL) on Sheet1 (LOA) ascending based on Employee Name.
2. Is it possible to automatically add a row (which includes all of the data validation/dropdowns from the rest of the table) to Table1 if there is data in the current last row or would I just need to make sure the table is large enough to accommodate additional employee rows?
3. I want columns A-B & H-AL to be locked unless a selection has been made in the dropdown for Column C (Employee Name).
   1. When opening the workbook, Columns A-B & H-AL should already be unlocked if column C (Employee Name) is not blank.
   2. Columns D-G should remain locked so users can’t mess up the formulas.
4. I would like the following columns to be automatically pulled from Sheet2 (Reference) depending on the data selected in Employee Name (which will use the Employee Name list on Sheet2 (Reference) for data validation). I'm not sure if XLookUP or if Index would be best for this.
   1. Column D – Emp ID
   2. Column E – Employment Condition
   3. Column F – Reports To
   4. Column G – DID
5. The data on Sheet2 (Reference) won’t always include the same number of employees so if the formulas for Emp ID, Employment Condition, Reports To, DID, and the data validation for Employee Name can automatically extend down to the last row of data that would be great.
   1. I will be updating the data on Sheet2 biweekly, but I don't want anyone else to change it so I'd like it to remain locked unless I unlock it.
6. Would it be possible to restrict users from cut/copy/paste any of the cells in Columns A-C, P, U, and AB (those are the cells with data validation)? If not, could I set it up so users receiving an error message when they go to cut/copy/paste?
7. Instead of using filters, I was hoping to insert slicers at the top so users can automatically filter based on 'Status', 'Trans Rep', and 'Employee Name'.

I have been trying all kinds of things to get this to work (even asking AI), but it keeps giving me code with errors and will eventually loop back to errors we've already fixed. That's why I want to learn more about VBA so I'm able to identify issues myself and correct them instead of having to rely on AI to be the expert.

Thank you so much and I really appreciate any insight you can give.

LOA Spreadsheet.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z	AA	AB	AC	AD	AE	AF	AG	AH	AI	AJ	AK	AL
1
2
3
4
5
6
7
8	Status	Trans Rep	Employee Name	Emp ID	Employment Condition	Reports To	DID	FMLA	PPL	MN P&P	Parenthood	Med.	Mil. (Paid)	Mil.	UNC Svs.	Leave Type	Anticipated Leave Start Date	Actual Leave Start Date	Anticipated Leave Return Date	Actual Leave Return Date	Short Term Disability	PPL Start Date	PPL End Date	PPL Exp. Date	Notes (No private medical information)	LOA Request Form Received	Date Leave Req.	RTW/Fitness for Duty Required	Date RTW/ Fitness for Duty Rec'd	Int. Coms for FY 2025 Sent on	Date Rights & Resp Sent	Prov. Leave Granted	Date Prov. Leave Granted	Cert Req.	Date Cert Rec'd	FMLA Approved	Designation Date	Date of Birth
9	Pending	Shaun	Thomas,Bill	2	Part-Time	Xavier,Charles	B04Z002	X		X						Continuous
10	Inactive	Julie	Smith,Jack	1	Full-Time	Gray,Jean	B04Z001
11	Active	Sam	Paulson,John	3	Intermitt	Rosenberg,Willow	B04Z003
12	Active	Becky	Samuelson,Sammy	7	Intermitt	Meyers,Seth	B04Z007
13	Inactive	Julie	Jacobson,Zach	4	Full-Time	Pryce,Wesley	B04Z004
14	Pending	Becky	Giles,Rupert	6	Full-Time	Kimmel,Jimmy	B04Z006
15	Pending	Shaun	Summer,Buffy	5	Full-Time	Holmes,Pete	B04Z005
16
LOA

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
AE9:AL29	Expression	=MOD(ROW(),2)	text	NO

Cells with Data Validation
Cell	Allow	Criteria
F9:F16	Any value
C8	Any value
D8	Any value
E8	Any value
F8	Any value
G8	Any value
H8	Any value
I8	Any value
J8	Any value
K8	Any value
L8	Any value
M8	Any value
N8	Any value
O8	Any value
A9:A15	List	Pending,Active,Inactive
U9:U16	List	N/A,Yes,No
P8	Any value
P9:P40	List	Continuous,Intermittent,Cont. & Int.,Reduced Schedule
AB9:AB16	List	Yes,No
B9:B40	List	Sam,Julie,Shaun,Becky
C9:C40	List	=References!$A$2:$A$8
D9:D40	Any value

 

[BeachDog_2600]

Update -

After a lot of trial and error, I was able to create code that would work. The only thing I can't figure out is how to have a warning message pop up when a user attempts to delete information in a call located in Column C that will let them proceed if needed, but also delete all of the information located in that row (excluding the data validation and formatting). Any help for this issue and/or feedback on my code would be greatly appreciated!

My current code is below:

Private Sub Workbook_Open()
    Dim ws As Worksheet
    Dim wsRef As Worksheet
    Dim lastRow As Long
    Dim lastRowRef As Long
    
    ' Set worksheet references
    Set ws = ThisWorkbook.Sheets("LOA")
    Set wsRef = ThisWorkbook.Sheets("References")
    
    ' Unprotect workbook and sheets
    ThisWorkbook.Unprotect "123456"
    ws.Unprotect "123456"
    wsRef.Unprotect "123456"
    
    ' Sort data on LOA sheet
    lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
    ws.Sort.SortFields.Clear
    ws.Sort.SortFields.Add Key:=ws.Range("C9:C" & lastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ws.Sort
        .SetRange ws.Range("A9:AL" & lastRow)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    ' Set up data validation for Employee Name
    lastRowRef = wsRef.Cells(wsRef.Rows.Count, "A").End(xlUp).Row
    With ws.Range("C9:C" & lastRow).Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=References!$A$2:$A$" & lastRowRef
    End With
    
    ' Set formulas for columns D-G
    ws.Range("D9:D" & lastRow).Formula = "=VLOOKUP(C9,References!$A$2:$G$" & lastRowRef & ",2,FALSE)"
    ws.Range("E9:E" & lastRow).Formula = "=VLOOKUP(C9,References!$A$2:$G$" & lastRowRef & ",3,FALSE)"
    ws.Range("F9:F" & lastRow).Formula = "=VLOOKUP(C9,References!$A$2:$G$" & lastRowRef & ",4,FALSE)"
    ws.Range("G9:G" & lastRow).Formula = "=VLOOKUP(C9,References!$A$2:$G$" & lastRowRef & ",5,FALSE)"
    
    ' Find the last row with data in column C
    lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
    
    ' Set the range for column C
    Set dataRange = ws.Range("C1:C" & lastRow)
    
    ' Loop through each cell in column C
    For Each cell In dataRange
        If Not IsEmpty(cell) Then
            ' Unlock corresponding cells in A, B, and H-AL
            ws.Range("A" & cell.Row & ":B" & cell.Row).Locked = False
            ws.Range("H" & cell.Row & ":AL" & cell.Row).Locked = False
        Else
            ' Lock corresponding cells in A, B, and H-AL
            ws.Range("A" & cell.Row & ":B" & cell.Row).Locked = True
            ws.Range("H" & cell.Row & ":AL" & cell.Row).Locked = True
        End If
    Next cell
    
    ws.Range("C9:C" & lastRow).Locked = False
    
    ' Protect LOA sheet
    ws.Protect "123456", UserInterfaceOnly:=True, AllowFiltering:=True, AllowSorting:=True
    
    ' Protect References sheet
    wsRef.Protect "123456"
    
    ' Protect workbook
    ThisWorkbook.Protect "123456"
End Sub

Option Explicit

Private Const WARNING_MESSAGE As String = "Warning: You are attempting to {0} data." & vbNewLine & _
    "That is not allowed in this spreadsheet. Please press 'ESC' to return to your work."

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo ErrorHandler
    
    If Not Intersect(Target, Me.Range("C:C")) Is Nothing Then
        Application.EnableEvents = False
        Me.Unprotect "123456"
        
        UpdateCellLockStatus Target
        
        Me.Protect "123456", UserInterfaceOnly:=True, AllowFiltering:=True, AllowSorting:=True
    End If

ExitSub:
    Application.EnableEvents = True
    Exit Sub

ErrorHandler:
    MsgBox "An error occurred: " & Err.Description, vbCritical, "Error"
    Resume ExitSub
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Application.CutCopyMode = False Then
        Select Case Application.CutCopyMode
            Case xlCut
                ShowWarningMessage "cut"
            Case xlCopy
                ShowWarningMessage "copy"
        End Select
    End If
End Sub

Private Sub UpdateCellLockStatus(ByVal Target As Range)
    Dim cell As Range
    Dim affectedRange As Range
    
    For Each cell In Intersect(Target, Me.Range("C:C"))
        Set affectedRange = Union(Me.Range("A" & cell.Row & ":B" & cell.Row), _
                                  Me.Range("H" & cell.Row & ":AL" & cell.Row))
        
        affectedRange.Locked = (cell.Value = "")
    Next cell
End Sub

Private Sub ShowWarningMessage(ByVal action As String)
    MsgBox Replace(WARNING_MESSAGE, "{0}", action), vbExclamation + vbOKOnly, "Data Modification Warning"
End Sub

Private Sub Worksheet_Change_Paste(ByVal Target As Range)
    If Not Application.CutCopyMode = False Then
        ShowWarningMessage "paste"
    End If
End Sub

Option Explicit

Sub AddNewRowToTable()
    
    Dim ws As Worksheet
    Dim tbl As ListObject
    Dim table_object_row As ListRow
    
    ' Set references to the worksheet and table
    Set ws = ThisWorkbook.Worksheets("LOA")  ' Replace "Sheet1" with your sheet name
    Set tbl = ws.ListObjects(1)  ' Replace "Table1" with your table name

    ' Unprotect workbook and sheets
    ws.Unprotect "123456"
    
    Set table_object_row = tbl.ListRows.Add
    table_object_row.Range(1, 1).Value = ""
    
    ' Protect LOA sheet
    ws.Protect "123456", UserInterfaceOnly:=True, AllowFiltering:=True, AllowSorting:=True
End Sub