Home > OS >  Why does "bCheck" always return "True"?
Why does "bCheck" always return "True"?

Time:05-11

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 here 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:

Worksheet_Tab

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! Immediate Window

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. enter image description here

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.

  • Related