boolean array and variant type vba

Question

I am getting unexpected results when passing a boolean() array to a variant type (the variant type resides inside a class module). I expect to get a value of true but am receiving false. I have provided code snippets below for comment

Private Sub validateEmployee(ByVal employeeCollection As collection)


Dim ws As Worksheet
Dim emp As Employee
Dim empID As Integer
Dim cell As String
Dim errors() As Boolean
Dim idx As Long
Dim arr() As String
Dim cell_address() As String

Dim flag_array() As Boolean
Dim m As Integer
Dim valid_flag As Boolean
Dim counter As Integer
Dim output As String

Sheet1.unProtectWS "x"

Set ws = Worksheets("x")

ws.Select
With Selection

    For Each emp In employeeCollection
        
        empID = empID + 1
        
        'Debug.Print ("validation runs... for emp: " & empID)
        
        'validate all fields within Employee Object
        'if invalid field exists colour it red
        'set global error flag to ensure no worksheet gets printed
        
        '######################################################
        'START Header  Section
        '######################################################
        
        'year 
        cell = emp.getJournalYearCell
        idx = 1
        ReDim errors(idx)
        
        If emp.getJournalYear = "" Then
            errors(idx) = True
            'emp.SetFlag idx, True
            Range(cell).Interior.Color = RGB(255, 0, 0)
        Else
            errors(idx) = False
            'emp.SetFlag idx, False
            Range(cell).Interior.Color = RGB(255, 255, 255)
        End If
        
        'region 
        cell = emp.getRegionCell
        idx = idx + 1
        ReDim errors(idx)
        
        If emp.getRegion = "" Then
            errors(idx) = True
            'emp.SetFlag idx, True
            Range(cell).Interior.Color = RGB(255, 0, 0)
        Else
            errors(idx) = False
            'emp.SetFlag idx, False
            Range(cell).Interior.Color = RGB(255, 255, 255)
        End If
        
        'district 
        cell = emp.getDistrictCell
        idx = idx + 1
        ReDim errors(idx)
        
        If emp.getDistrict = "" Then
            errors(idx) = True
            'emp.SetFlag idx, True
            Range(cell).Interior.Color = RGB(255, 0, 0)
        Else
            errors(idx) = False
            'emp.SetFlag idx, False
            Range(cell).Interior.Color = RGB(255, 255, 255)
        End If
        
        'journal number 
        cell = emp.getJournalNumberCell
        idx = idx + 1
        ReDim errors(idx)
        
        If emp.getJournalNumber = "" Then
            errors(idx) = True
            'emp.SetFlag idx, True
            Range(cell).Interior.Color = RGB(255, 0, 0)
        Else
            errors(idx) = False
            'emp.SetFlag idx, False
            Range(cell).Interior.Color = RGB(255, 255, 255)
        End If
        
        '######################################################
        ' END Header  Section
        '######################################################
        
        
        '#########################
        'START Employee Line Items
        '#########################
        
        'employee name
        cell = emp.getNameCell
        idx = idx + 1
        ReDim errors(idx)
        
        If emp.getName = "" Then
            errors(idx) = True
            'emp.SetFlag idx, True
            Range(cell).Interior.Color = RGB(255, 0, 0)
        Else
            errors(idx) = False
            'emp.SetFlag idx, False
            Range(cell).Interior.Color = RGB(255, 255, 255)
        End If
        
        'classification code
        cell = emp.getClassCodeCell
        idx = idx + 1
        ReDim errors(idx)
        
        If emp.getClassCode = "" Then
            errors(idx) = True
            'emp.SetFlag idx, True
            Range(cell).Interior.Color = RGB(255, 0, 0)
        Else
            errors(idx) = False
            'emp.SetFlag idx, False
            Range(cell).Interior.Color = RGB(255, 255, 255)
        End If
        
        'hourly rate
        cell = emp.getHourlyRateCell
        idx = idx + 1
        ReDim errors(idx)
        
        If emp.getHourlyRate = "" Then
            errors(idx) = True
            'emp.SetFlag idx, True
            Range(cell).Interior.Color = RGB(255, 0, 0)
        Else
            errors(idx) = False
            'emp.SetFlag idx, False
            Range(cell).Interior.Color = RGB(255, 255, 255)
        End If
        
        'certification number
        cell = emp.getCertNumberCell
        idx = idx + 1
        ReDim errors(idx)
        
        If emp.getCertNumber = "" Then
            errors(idx) = True
            'emp.SetFlag idx, True
            Range(cell).Interior.Color = RGB(255, 0, 0)
        Else
            errors(idx) = False
            'emp.SetFlag idx, False
            Range(cell).Interior.Color = RGB(255, 255, 255)
        End If
        
        'employee day
        cell = emp.getEDayCell
        idx = idx + 1
        ReDim errors(idx)
        
        If emp.getDay = "" Then
            errors(idx) = True
            'emp.SetFlag idx, True
            Range(cell).Interior.Color = RGB(255, 0, 0)
        Else
            errors(idx) = False
            'emp.SetFlag idx, False
            Range(cell).Interior.Color = RGB(255, 255, 255)
        End If
        
        'employee month
        cell = emp.getEMonthCell
        idx = idx + 1
        ReDim errors(idx)
        
        If emp.getMonth = "" Then
            errors(idx) = True
            'emp.SetFlag idx, True
            Range(cell).Interior.Color = RGB(255, 0, 0)
        Else
            errors(idx) = False
            'emp.SetFlag idx, False
            Range(cell).Interior.Color = RGB(255, 255, 255)
        End If
        
        'employee year
        cell = emp.getEYearCell
        idx = idx + 1
        ReDim errors(idx)
        
        If emp.getEYear = "" Then
            errors(idx) = True
            'emp.SetFlag idx, True
            Range(cell).Interior.Color = RGB(255, 0, 0)
        Else
            errors(idx) = False
            'emp.SetFlag idx, False
            Range(cell).Interior.Color = RGB(255, 255, 255)
        End If
        
        'cheque number
        cell = emp.getChequeNoCell
        idx = idx + 1
        ReDim errors(idx)
        
        If emp.getChequeNo = "" Then
            errors(idx) = True
            'emp.SetFlag idx, True
            Range(cell).Interior.Color = RGB(255, 0, 0)
        Else
            errors(idx) = False
            'emp.SetFlag idx, False
            Range(cell).Interior.Color = RGB(255, 255, 255)
        End If
        
        'mailing address field 1
        cell = emp.getAddress1Cell
        idx = idx + 1
        ReDim errors(idx)
        
        If emp.getAddress1 = "" Then
            errors(idx) = True
            'emp.SetFlag idx, True
            Range(cell).Interior.Color = RGB(255, 0, 0)
        Else
            errors(idx) = False
            'emp.SetFlag idx, False
            Range(cell).Interior.Color = RGB(255, 255, 255)
        End If
        
        'mailing address field 2
        cell = emp.getAddress2Cell
        idx = idx + 1
        ReDim errors(idx)
        
        If emp.getAddress2 = "" Then
            errors(idx) = True
            'emp.SetFlag idx, True
            Range(cell).Interior.Color = RGB(255, 0, 0)
        Else
            errors(idx) = False
            'emp.SetFlag idx, False
            Range(cell).Interior.Color = RGB(255, 255, 255)
        End If
        
        '****************************
        'START SIN 
        '****************************
        
        
        'sin or treaty dropdown
        cell = emp.getSinOrTreatyAddress
        idx = idx + 1
        ReDim errors(idx)
        
        
        
        
        
        'fetch ssn array
        arr = emp.getSSN
        
        'fetch ssn cell address range
        cell_address = emp.getSSN_cells
        
        If emp.getSinOrTreaty = "" Or emp.getSinOrTreaty = "sin" Then
            
            Dim str As String
            Dim i As Integer
            Dim c As String
            
            Dim flag As Boolean
            
            'toggle sinOrTreaty dropdown menu
            If emp.getSinOrTreaty = "" Then
                Range(cell).Interior.Color = RGB(255, 0, 0)
            Else
                Range(cell).Interior.Color = RGB(255, 255, 255)
            End If
            
            
            For i = LBound(arr) To UBound(arr)
                str = str & arr(i)
            Next i
            'Debug.Print (str)
            
            'return overall result ie. valid or invalid SIN
            'if sin is not valid, return false in this circumstance
            flag = Utility.Verify_SIN(str)
            'Debug.Print (flag)
            
            
            
            If flag = False Then
                'SIN invalid
                errors(idx) = True
                'emp.SetFlag idx, True
                
                'set range
                Range(cell_address(1), cell_address(9)).Interior.Color =   RGB(255, 0, 0)
                
            Else
                errors(idx) = False
                'emp.SetFlag idx, False
                Range(cell_address(1), cell_address(9)).Interior.Color = RGB(255, 255, 255)
            End If
                    
        Else
            'treaty number is not validated
            errors(idx) = False
            'emp.SetFlag idx, False
            Range(cell_address(1), cell_address(9)).Interior.Color = RGB(255, 255, 255)
        End If
        
        '****************************
        'END SIN
        '****************************
    
    
        '#########################
        'END Employee Line Items
        '#########################
           
        
        '#########################
        'START FOOTER SECTION
        '#########################
        
        'prepared by field
        cell = emp.getPreparedByCell
        idx = idx + 1
        ReDim errors(idx)
        
        If emp.getPreparedBy = "" Then
            errors(idx) = True
            'emp.SetFlag idx, True
            Range(cell).Interior.Color = RGB(255, 0, 0)
        Else
            errors(idx) = False
            'emp.SetFlag idx, False
            Range(cell).Interior.Color = RGB(255, 255, 255)
        End If
        
        'print name field
        cell = emp.getPrintedNameCell
        idx = idx + 1
        ReDim errors(idx)
        
        If emp.getPrintedName = "" Then
            errors(idx) = True
            'emp.SetFlag idx, True
            Range(cell).Interior.Color = RGB(255, 0, 0)
        Else
            errors(idx) = False
            'emp.SetFlag idx, False
            Range(cell).Interior.Color = RGB(255, 255, 255)
        End If
        
        '#########################
        'END FOOTER SECTION
        '#########################
        
        '##########################
        'Validate Commissary Amount
        '##########################
        
        emp.setErrors = errors
        
        
        
        'check errors, true is not found but why
        Dim y As Long
        y = 0
        
       

        For y = 0 To 17
            Debug.Print (emp.hasErrors()(y))
            
            If emp.hasErrors()(y) = True Then
                valid_flag = False
                'exit on first error thrown
                Exit For
            Else
                'set marker
                valid_flag = True
            End If
        Next y

        
       flag_array = emp.hasErrors

       
    Next emp
    
    
    
    
End With

'###################
'Create worksheet
'###################

'idea; create only valid worksheets ie. only send valid worksheets for printing

For Each emp In employeeCollection

    flag_array = emp.hasErrors

    For m = LBound(flag_array) To UBound(flag_array)

        If (flag_array(m) = True) Then
            'exit on first error thrown
            Exit For
        Else
            'set marker
            valid_flag = True
            counter = counter + 1
        End If

    Next m

Next emp


'worksheet free from validation errors
If (valid_flag = True And empID = 15) Then
    createWS employeeCollection
Else
    output = "worksheet contains errors, please correct fields in red."
    MsgBox (output)
End If




Sheet1.protectWS "x"
        
End Sub

Answer 1

On edit: In the code for SetFlag I now create or extend the array if need be.

The problem is that the Get returns a copy of the private array -- so the code using the class changes a copy of the private array rather than the private array itself. A workaround is to provide methods to access the array. For example, in your class definition add this (I didn't know the name of the class so I made it Employee):

Public Sub SetFlag(i As Long, b As Boolean)
    If Not IsArray(errors) Then
        ReDim errors(0 To i) As Boolean
    ElseIf UBound(errors) < i Then
        ReDim Preserve errors(LBound(errors) To i) As Boolean
    End If
    errors(i) = b
End Sub   

Public Function GetFlag(i As Long) As Boolean
    GetFlag = errors(i)
End Function

A test sub:

Sub test()
    Dim b(1 To 4) As Boolean
    Dim e As New Employee
    b(1) = False
    b(2) = True
    b(3) = True
    b(4) = False

    e.setErrors = b
    Debug.Print e.hasErrors()(3) 'prints True
    e.hasErrors()(3) = False
    Debug.Print e.hasErrors()(3) '*Still* prints True

    'but:
    e.SetFlag 3, False
    Debug.Print e.hasErrors()(3) 'now prints False
    'or just:
    Debug.Print e.GetFlag(3) 'Prints False   
End Sub