Hi, RobSA!
I had time to play a bit with your file and did this:
a) Kept changes of previous a), 2 hidden columns E:F
b) Kept parameters Date Start and Date End of previous e), and added WS Format
c) Set up protection for all cells in summary worksheet except those of b)
d) There added 3 buttons, Create Missing, Delete Residual and Clear All
e) For template worksheet, set up protection for all non-editable cells
f) For template worksheet, defined 2 named ranges with worksheet scope for the form and the date (K14)
g) There added 1 button, Clear form
How does this work?
- at open and close time all worksheets get protected
- worksheet details: 1 summary, 1 template, n monthly
- n monthly are tied to start/end dates
- green button Create Missing copies template worksheet as YYYY-MM and sets date (K14) to 01/MM/YYYY for each month in start/end dates range, and adds rows properly in summary table
- red button Delete residual delete worksheets with names out of start/end dates range, and deletes rows properly in summary table
- yellow button Clear All clears editable cells in all monthly worksheets
I almost forget about this: Excel security is like Santa, Batman or Spiderman, just exists in the movies. But an anti-dumb/curious/newbie unwilling workbook spoil can be prevented password protecting the worksheets, and in this case the VBA project too (where the actual password for the worksheets is stored). I used the name of that mountain with three volcanic cones Kibo, Mawenzi and Shira. In capital letters.
Once you find out it (I guess it'll be easy for you), if you want to change it proceed as follows:
- from the VBA editor, immediate window, type "UnprotectWS"
- from the VBA editor, left panel, VBA project, properties, protection, check block and enter new password.
I think that I'm not missing anything, but the code. Here it is:
Code:
Option Explicit
' global constants
' security
Const gksPassword = "Kilimanjaro"
' worksheets
Const gksWSSummary = "RETURN CONSOLIDATED"
Const gksWSTemplate = "Template"
' ranges
Const gksRngDateStart = "DateStartCell"
Const gksRngDateEnd = "DateEndCell"
Const gksRngWSFormat = "WSFormatCell"
Const gksRngSummary = "SummaryTable"
Const gksRngDate = "DateList"
Const gksRngTemplate = "TemplateTable"
Const gksRngReportMonth = "ReportMonthCell"
' global declarations
' ranges
Dim grngS As Range, grngD As Range, grngT As Range
' dates
Dim gdStart As Date, gdEnd As Date, gsFormat As String
Sub CreateMissing()
' constants
' declarations
Dim rng As Range
Dim I As Integer, A As String, D As Date
' start
Set grngS = Worksheets(gksWSSummary).Range(gksRngSummary)
Set grngD = Worksheets(gksWSSummary).Range(gksRngDate)
gdStart = Worksheets(gksWSSummary).Range(gksRngDateStart).Value
gdEnd = Worksheets(gksWSSummary).Range(gksRngDateEnd).Value
gsFormat = Worksheets(gksWSSummary).Range(gksRngWSFormat).Value
UnprotectWS gksWSSummary
' process
' main
D = gdStart - Day(gdStart) + 1
Do While D <= DateSerial(Year(gdEnd), Month(gdEnd), 1)
' date
A = Format(D, gsFormat)
' ws
Set rng = Nothing
On Error Resume Next
Set rng = Worksheets(A).Cells(1, 1)
On Error GoTo 0
If rng Is Nothing Then
Worksheets(gksWSTemplate).Copy After:=Worksheets(Worksheets.Count)
With ActiveSheet
.Name = A
.Range(gksRngReportMonth).Value = D
.[D4].Select
End With
End If
' table row
UnprotectWS A
With grngS
For I = 2 To .Rows.Count
If .Cells(I, 1).Value = D Then Exit For
Next I
If I > .Rows.Count Then
If .Rows.Count > 1 Then .Rows(2).Copy .Rows(I)
.Cells(I, 1).Value = D
Set grngS = .Resize(.Rows.Count + 1)
End If
End With
ProtectWS A
' cycle
D = DateSerial(Year(D), Month(D) + 1, 1)
Loop
' sort
Set grngD = grngD.Resize(grngS.Rows.Count)
With grngD.Parent
With .Sort
With .SortFields
.Clear
.Add Key:=grngD, SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
End With
.SetRange grngD
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
' end
With Worksheets(gksWSSummary)
.Activate
.Cells(1, 1).Select
End With
ProtectWS gksWSSummary
Set rng = Nothing
Set grngD = Nothing
Set grngS = Nothing
Beep
End Sub
Sub DeleteResidual()
' constants
Const ksSeparator = "-"
' declarations
Dim I As Integer, J As Integer, D As Date
' start
Set grngS = Worksheets(gksWSSummary).Range(gksRngSummary)
gdStart = Worksheets(gksWSSummary).Range(gksRngDateStart).Value
gdEnd = Worksheets(gksWSSummary).Range(gksRngDateEnd).Value
UnprotectWS gksWSSummary
' process
For I = Worksheets.Count To 1 Step -1
With Worksheets(I)
If .Name <> gksWSSummary And .Name <> gksWSTemplate Then
' date
D = DateValue(.Name & ksSeparator & 1)
If D < gdStart - Day(gdStart) + 1 Or D > gdEnd - Day(gdEnd) + 1 Then
' ws
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
' table row
For J = 2 To grngS.Rows.Count
If grngS.Cells(J, 1).Value = D Then Exit For
Next J
If J <= grngS.Rows.Count Then
If grngS.Rows.Count > 2 Then
grngS.Rows(J).Delete Shift:=xlShiftUp
Else
grngS.Cells(J, 1).ClearContents
End If
End If
End If
End If
End With
Next I
' end
Worksheets(gksWSSummary).Activate
ProtectWS gksWSSummary
Set grngS = Nothing
Beep
End Sub
Sub ClearAll()
' constants
' declarations
' start
' process
ClearWS
' end
Beep
End Sub
Sub ClearWS(Optional pvWS As Variant)
' constants
' declarations
Dim sWS As String
Dim I As Integer
' start
If IsMissing(pvWS) Then sWS = "" Else sWS = CStr(pvWS)
' process
For I = 1 To Worksheets.Count
With Worksheets(I)
If (sWS = "" Or sWS = .Name) And _
.Name <> gksWSSummary And .Name <> gksWSTemplate Then
UnprotectWS .Name
Union(.[D4:D6], .[K4:K6], .[D9:F46], .[G10], .[G21], .[G27], _
.[G34], .[G38], .[C54:L58]).Select
Selection.ClearContents
.[D4].Select
ProtectWS .Name
End If
End With
Next I
' end
Beep
End Sub
Sub ProtectWS(Optional pvWS As Variant)
' constants
' declarations
Dim sWS As String
Dim I As Integer
' start
If IsMissing(pvWS) Then sWS = "" Else sWS = CStr(pvWS)
' process
For I = 1 To Worksheets.Count
With Worksheets(I)
If (sWS = "" Or sWS = .Name) Then
Worksheets(I).Protect gksPassword
End If
End With
Next I
' end
If sWS = "" Then Beep
End Sub
Sub UnprotectWS(Optional pvWS As Variant)
' constants
' declarations
Dim sWS As String
Dim I As Integer
' start
If IsMissing(pvWS) Then sWS = "" Else sWS = CStr(pvWS)
' process
For I = 1 To Worksheets.Count
With Worksheets(I)
If (sWS = "" Or sWS = .Name) Then
Worksheets(I).Unprotect gksPassword
End If
End With
Next I
' end
If sWS = "" Then Beep
End Sub
Give a look at it and just advise if any issue or ask if any doubt.
Regards!