diff --git a/VBA/VBA-Code_By_Modules/DuplicateActualRoster.bas b/VBA/VBA-Code_By_Modules/DuplicateActualRoster.bas new file mode 100644 index 0000000..fc7b272 --- /dev/null +++ b/VBA/VBA-Code_By_Modules/DuplicateActualRoster.bas @@ -0,0 +1,45 @@ +Attribute VB_Name = "DuplicateActualRoster" +Sub DuplicateActualRoster() + Dim srcSheet As Worksheet + Dim copySheet As Worksheet + Dim sheetName As String + Dim enteredPassword As String + Const password As String = "rostering2025" + + enteredPassword = InputBox("Please enter the password to duplicate the roster:", "Password Authentication") + If enteredPassword <> password Then + MsgBox "Incorrect password. Duplicate operation declined.", vbCritical + Exit Sub + End If + + Set srcSheet = Sheets("Roster") + sheetName = "ActualRoster_" & Format(Now, "yyyymmdd_hhnn") + + srcSheet.Copy After:=Sheets(Sheets.count) + Set copySheet = ActiveSheet + copySheet.Name = sheetName + + 'With srcSheet.UsedRange + ' .Copy Destination:=copySheet.Range("A1") + 'End With + + ' Remove all shapes (e.g., buttons, form controls, etc.) + For Each shp In copySheet.Shapes + shp.Delete + Next shp + + With copySheet.Cells + .Locked = True + End With + + copySheet.Protect password:="nuslib2017@52", _ + AllowSorting:=True, _ + AllowFiltering:=True, _ + AllowFormattingCells:=True + + + srcSheet.Activate + +End Sub + + diff --git a/VBA/VBA-Code_By_Modules/DuplicateSystemRoster.bas b/VBA/VBA-Code_By_Modules/DuplicateSystemRoster.bas new file mode 100644 index 0000000..e6b98eb --- /dev/null +++ b/VBA/VBA-Code_By_Modules/DuplicateSystemRoster.bas @@ -0,0 +1,43 @@ +Attribute VB_Name = "DuplicateSystemRoster" +Sub DuplicateSystemRoster() + Dim srcSheet As Worksheet + Dim copySheet As Worksheet + Dim sheetName As String + + Set wsRoster = Sheets("Roster") + Set srcSheet = wsRoster + sheetName = "SystemRoster_" & Format(Now, "yymmdd_hhnn") + + 'Copy the whole sheet + srcSheet.Copy After:=Sheets(Sheets.count) + Set copySheet = ActiveSheet + copySheet.Name = sheetName + + 'With srcSheet.UsedRange + ' copySheet.Range("A1").Resize(.Rows.Count, .Columns.Count).Value = .Value + ' Application.CutCopyMode = False + 'End With + + ' Remove all shapes (e.g., buttons, form controls, etc.) + For Each shp In copySheet.Shapes + shp.Delete + Next shp + + With copySheet.Cells + .Locked = True + End With + + copySheet.Protect password:="nuslib2017@52", _ + AllowSorting:=True, _ + AllowFiltering:=True, _ + AllowFormattingCells:=True + + wsRoster.Activate + +End Sub + + + + + +