Collections

[tiredofit]

This code is taken from the book, VBA and Macros For Excel 2003.

Put a,b,c,d in column A, 1,2,3,4 in column B, 10,20,30,40 in column C and 5,6,7,8 in column D.

Standard module:

Sub EmpPayCollection()
    Dim colEmployees As New Collection
    Dim recEmployee As New ClsEmployee
    Dim LastRow As Integer, myCount As Integer
    Dim EmpArray As Variant
    
    LastRow = ActiveSheet.Range("A65536").End(xlUp).Row
    
    EmpArray = ActiveSheet.Range(Cells(1, 1), Cells(LastRow, 4))
    
    For myCount = 1 To UBound(EmpArray)
    
    With recEmployee
    
        .EmpName = EmpArray(myCount, 1)
        .EmpID = EmpArray(myCount, 2)
        .EmpRate = EmpArray(myCount, 3)
        .EmpWeeklyHrs = EmpArray(myCount, 4)
        colEmployees.Add recEmployee, .EmpID
    
    End With
    
    Next myCount
    
    MsgBox "Number of Employees: " & colEmployees.Count & Chr(10) & "Employee(2) Name: " & colEmployees(2).EmpName
    
    Set recEmployee = Nothing
End Sub

ClsEmployee

Option Explicit
    
    Public EmpName As String
    Public EmpID As String
    Public EmpRate As Double
    Private NormalHrs As Double
    Private OverHrs As Double
Property Let EmpWeeklyHrs(Hrs As Double)
    NormalHrs = WorksheetFunction.Min(40, Hrs)
    OverHrs = WorksheetFunction.Max(0, Hrs - 40)
End Property
Property Get EmpWeeklyHrs() As Double
    EmpWeeklyHrs = NormalHrs + OverHrs
End Property
Property Get EmpNormalHrs() As Double
    EmpNormalHrs = NormalHrs
End Property
Property Get EmpOverTimeHrs() As Double
    EmpOverTimeHrs = OverHrs
End Property
Public Function EmpWeeklyPay() As Double
    EmpWeeklyPay = (EmpNormalHrs * EmpRate) + (EmpOverTimeHrs * EmpRate * 1.5)
End Function

What I can't work out is why running the code, the message box shows:

Employee(2) Name: d

even if I change this line to:

MsgBox "Number of Employees: " & colEmployees.Count & Chr(10) & "Employee(2) Name: " & colEmployees(1).EmpName

or any other number.

 

[Tubal]

Tired,

Step it through the code with a watch on colEmployees and the entire collection takes on the value of the last recEmployee added. Now I fully admit that class mods are new to me, but this looks like a ByRef vs. ByVal thing. That is to say, I would expect the .Add to put in the collect data "ByVal", but it changes everyone as if the collection is "ByRef".

Anyone have insight?

Tubal

 

[RickXL]

Hi,

There seems to be a line missing:

Option Explicit

Sub EmpPayCollection()
    Dim colEmployees As New Collection
    Dim recEmployee As ClsEmployee
    Dim LastRow As Integer, myCount As Integer
    Dim EmpArray As Variant
    
    LastRow = ActiveSheet.Range("A65536").End(xlUp).Row
    
    EmpArray = ActiveSheet.Range(Cells(1, 1), Cells(LastRow, 4))
    
    For myCount = 1 To UBound(EmpArray)
        Set recEmployee = New ClsEmployee
        With recEmployee
            .EmpName = EmpArray(myCount, 1)
            .EmpID = EmpArray(myCount, 2)
            .EmpRate = EmpArray(myCount, 3)
            .EmpWeeklyHrs = EmpArray(myCount, 4)
            colEmployees.Add recEmployee, .EmpID
        
        End With
    
    Next myCount
    
    MsgBox "Number of Employees: " & colEmployees.Count & Chr(10) & "Employee(2) Name: " & colEmployees(1).EmpName
    
    Set recEmployee = Nothing
End Sub

Also, you don't need the "New" in the Dim.

Basically, ClsEmployee is a template. Creating a new one and calling it recEmployee makes a version of it available in the macro. If you change that one then you just overwrite. What you need to do is create a second instance for the second piece of data. The collection records all the instances.

 

[tiredofit]

Thanks.

The code was taken from the book, so I suppose they got it wrong.

 

[RickXL]

Hi,

All good books should have the occasional error to keep the readers on their toes