I have been working on a Macro that will automatically add new Annual Worksheets when the Calendar Year Changes. My current Code is as follows:
Option Explicit
Sub addAnnualWkst()
Dim ws As Worksheet
Dim wsM As Worksheet
Dim strName As String
Dim strNamePreYr As String
Dim bCheck As Boolean
Dim pID As String
Dim rw
Set propIDs = ThisWorkbook.Names("propIDs").RefersToRange
Set actStatus = ThisWorkbook.Names("actStatus").RefersToRange
On Error Resume Next
Set wsM = Worksheets("WkstMaster")
For rw = 1 To propIDs.Count
If propIDs.Cells(rw, 1).Value2 <> vbNullString Then
If actStatus.Cells(rw, 1).Value2 = True Then
pID = propIDs.Cells(rw, 1).Value2
strName = pID & "_" & (Format(Date, "yyyy"))
strNamePreYr = pID & "_" & (Format(Date, "yyyy") - 1)
bCheck = Len(Sheets(strName).Name) > 0
Debug.Print pID, strName, strNamePreYr, bCheck
If bCheck = False Then
'add new sheet after Previous Year's Worksheet
wsM.Copy After:=Sheets(strNamePreYr)
ActiveSheet.Name = strName
End If
End If
End If
Next
Set wsM = Nothing
End Sub
the code above is based in part on on a Macro I found in a Tutorial I found and the
Module Code is:
Option Explicit
Sub AddMonthWkst()
Dim ws As Worksheet
Dim wsM As Worksheet
Dim strName As String
Dim bCheck As Boolean
On Error Resume Next
Set wsM = Sheets("Wkst_Master")
strName = Format(Date, "yyyy_mm")
bCheck = Len(Sheets(strName).Name) > 0
If bCheck = False Then
'add new sheet after Instructions
wsM.Copy After:=Sheets(1)
ActiveSheet.Name = strName
End If
Set wsM = Nothing
End Sub
The above 'code' works as advertised! bCheck returns False and the new worksheet is added. I am able to rename the worksheet tab from the current month 05 to the previous month 04, save and close the workbook and when I reopen the workbook a new worksheet is automatically added with the 05 month extension.
I modified the code slightly to fit my needs and incapsulated that code in a subroutine I successfully use in different parts of the application where I select pIDs based on actStatus.
I have active Worksheet Tabs for the various PropIDs as shown in this image:
When I run the Macro the Immediate Window shows ALL Active pIDs with a pCheck Value as True when the pID "Rev" should return a value of False because pID "Rev" does not have a WorkSheet for the current year!
As one can see for the Immediate window screenshot below, all the relevant pIDs are there!

If I disable the 'On Error Resume Next' line I get the Runtime Error: 9, Script out of range error and with or without the Error Trap the worksheet is not added. the Error happens at the highlighted line of code.

Please help me to resolve this issue. I know it is something simple I am missing! Thanks in advance.
CodePudding user response:
This is your problem:
Sub TesterLoop()
Dim bCheck As Boolean, s
On Error Resume Next
'Sheet4 doesn't exist
For Each s In Array("Sheet1", "Sheet2", "Sheet4")
'if the next line has an error then the value of bCheck is *unchanged*
bCheck = Len(ThisWorkbook.Sheets(s).Name) > 0
Debug.Print s, bCheck
Next s
End Sub
Output:
Sheet1 True
Sheet2 True
Sheet4 True '<<<oops! Still has the Sheet2 value...
The value of bCheck can only be set when that line executes with no error: if there's an error then bCheck still has its initial False value, or the value from the previous loop iteration.
If you add
bCheck = False
before that line it will fix your problem.
But it's a bad idea to let On Error Resume Next cover that much of your code, and you'd be better off factoring out that check into a standalone function as suggested in the comments.
CodePudding user response:
Thanks to those who pointed me in direction of a possible solution.
Here is the the Solution I came up with!
Sub addAnnualWkst()
Dim ws As Worksheet
Dim wsM As Worksheet
Dim strName As String
Dim strNamePreYr As String
Dim bCheck As Boolean
Dim exists
Dim pID As String
Dim rw
Set propIDs = ThisWorkbook.Names("propIDs").RefersToRange
Set actStatus = ThisWorkbook.Names("actStatus").RefersToRange
Set wsM = Worksheets("WkstMaster")
For rw = 1 To propIDs.Count
If propIDs.Cells(rw, 1).Value2 <> vbNullString Then
If actStatus.Cells(rw, 1).Value2 = True Then
pID = propIDs.Cells(rw, 1).Value2
cName = pID & (Format(Date, "yyyy"))
strName = pID & "_" & (Format(Date, "yyyy"))
strNamePreYr = pID & "_" & (Format(Date, "yyyy") - 1)
If Not wsExists(strName) Then
Debug.Print pID, strName, strNamePreYr
wsM.Copy After:=Sheets(strNamePreYr)
ActiveSheet.Name = strName
End If
End If
End If
Next
Set wsM = Nothing
End Sub
Function wsExists(strName As String) As Boolean
Dim ws: For Each ws In Sheets
wsExists = (strName = ws.Name): If wsExists Then Exit Function
Next ws
End Function
The only 'pID' that appears in the Immediate Window is the pID missing the 2022 extension.

