I have an Excel file that has 10K contract records. Each contract will have a name, a contract version, contract effective date, contract expiration date. For the purpose of reporting I only want the last version of any contract. How do I find the last version of a contract record, if there are multiple contract versions?
Token Usage
-------------------------------------------------------------
<<clsLevel1>> Parent class name
<<clsLevel2>> Child class name
<<clsLevel3>> "Next level" class name
<<Name>> Child property used as key in collection
<<Level3>> Child property used to refer to "next level"
<<Byline>> Comment with customizable byline
<<CreatedDate>> Comment containing current date
<<Text>> Used to set Option Compare Text|Binary
' Patrick Matthews
' Created 2012-10-28
' Parent collection class of clsChild
Option Explicit
Option Compare Text
' Container for all clsChild objects in the parent collection class
Private coll As Collection
Private Sub Class_Initialize()
Set coll = New Collection
End Sub
Private Sub Class_Terminate()
Set coll = Nothing
End Sub
Public Function Add(Name As String) As clsChild
' Adds a new item to the collection. Causes an error if an item with the same key already exists
' or if you pass a zero length string for the Name argument
If Name = "" Then
Err.Raise vbObjectError + 1002, , "Name property of clsChild object cannot be zero length string"
End If
Set Add = New clsChild
Add.Name = Name
' Raise an error and set return value to Nothing if we fail to add item to collection (most likely
' because an item already exists with the same key
On Error GoTo ErrHandler
coll.Add Add, Name
Exit Function
ErrHandler:
Set Add = Nothing
Err.Raise vbObjectError + 1003, , "Could not add item '" & Name & "' to clsParent collection"
End Function
Public Sub Clear()
' Recreates (and thus clears) collection
Set coll = New Collection
End Sub
Property Get Count() As Long
' Returns number of items in the collection
' Read-only
Count = coll.Count
End Property
Function Exists(Name As String) As Boolean
' Returns True if a clsChild member specified by the Name exists in clsParent parent collection
Dim TempItem As clsChild
On Error GoTo CleanUp
' Default return is False
Exists = False
' If item exists, then the Set operation completes without error
Set TempItem = coll(Name)
Exists = True
CleanUp:
Set TempItem = Nothing
End Function
Property Get Item(Index As Variant) As clsChild
' Default property. Returns an item from the collection. Index may be either ordinal position (Long) or Name (String)
' Read-only
On Error GoTo ErrHandler
Set Item = coll(Index)
Exit Property
ErrHandler:
Set Item = Nothing
Err.Raise vbObjectError + 1004, , "Item does not exist in clsParent collection"
End Property
Function Keys() As Variant
' Returns a 1-based array of the various strings used as Name key values for the clsChild items
' in the clsParent collection"
Dim Counter As Long
Dim Results() As String
' If there are no items in the clsParent collection then raise an error
If Me.Count > 0 Then
' Redimension array so there is one member per clsChild item in clsParent collection
ReDim Results(1 To Me.Count) As String
' Loop through clsParent collection and grab Name values for each clsChild item
For Counter = 1 To Me.Count
Results(Counter) = Me(Counter).Name
Next
' Set return value
Keys = Results
Else
' Raise error for no items
Err.Raise vbObjectError + 1005, , "Keys method failed: no clsChild items exist in clsParent collection"
End If
End Function
Public Sub Remove(Index As Variant)
' Removes an item from the collection. Index may be either ordinal position (Long) or Name (String)
coll.Remove Index
End Sub
Function NewEnum() As IUnknown
' Enables enumeration of the clsParent parent collection, i.e.:
'
' For Each Child In Parent...Next
Set NewEnum = coll.[_NewEnum]
End Function
' Patrick Matthews
' Created 2012-10-28
Option Explicit
Option Compare Binary
' Container for read-only property
Private Safe_NextLevel As clsNextLevel
' Container for "write-once read-many" property
Private Safe_Name As String
Private Sub Class_Initialize()
Set Safe_NextLevel = New clsNextLevel
End Sub
Private Sub Class_Terminate()
Set Safe_NextLevel = Nothing
End Sub
Property Get NextLevel() As clsNextLevel
' Returns reference to item's clsNextLevel collection
' Read-only
Set NextLevel = Safe_NextLevel
End Property
Property Get Name() As String
' Returns item's Name value
Name = Safe_Name
End Property
Property Let Name(NameString As String)
' Sets Name value for item
' This makes the Name property "write once, read many". If the Name is a zero length string,
' the Property Let allows you to change it; if not, the procedure raises a user defined
' error. Basically, we cannot allow changes because we want this property to match the
' item's true key used when it was added to the parent clsParent collection
If Safe_Name = "" Then
Safe_Name = NameString
Else
Err.Raise vbObjectError + 1001, , "Cannot change Name property of clsChild object"
End If
End Property
' Patrick Matthews
' Created 2012-10-28
Option Explicit
Option Compare Text
' Container for "write-once read-many" property
Private Safe_Name As String
Property Get Name() As String
' Returns item's Name value
Name = Safe_Name
End Property
Property Let Name(NameString As String)
' Sets Name value for item
' This makes the Name property "write once, read many". If the Name is a zero length string,
' the Property Let allows you to change it; if not, the procedure raises a user defined
' error. Basically, we cannot allow changes because we want this property to match the
' item's true key used when it was added to the parent clsParent collection
If Safe_Name = "" Then
Safe_Name = NameString
Else
Err.Raise vbObjectError + 1001, , "Cannot change Name property of clsChild object"
End If
End Property
Have a question about something in this article? You can receive help directly from the article author. Sign up for a free trial to get started.
Comments (26)
Commented:
Do the class description graphics need to reflect the new Exists method?
Author
Commented:Commented:
As long as the graphics are meaningful and in-sync with the original question, then there shouldn't be any need to change them.
Commented:
Author
Commented:Technically, that "Workload Object Model" was from an Access project. Work for hire, so I can't post the original here (it would be a royal pain to obfuscate it enough to post).
But my approach would have worked :)
View More