'indexes of the values stored as an array in the collection object
Private Const USERNAME As Integer = 0
Private Const DATETIME As Integer = 1
'references to where the data is or should be in the workbook
Public Enum DataColumns
DateTimeStamp = 1
UName = 2
Department = 3
LastUpdater = 4 'The information we will be adding!
End Enum
Sub Main()
Dim lastUserByDept As Collection
Set lastUserByDept = GetLastUpdater(2)
AppendLastUserName 2, lastUserByDept
End Sub
'//Builds a collection of department entries, and stores
'//the last date along with the user tied to that date
Private Function GetLastUpdater(dataStartRow As Long) As Collection
Dim currRow As Integer: currRow = dataStartRow
Dim maxDatesByDept As Collection
Set maxDatesByDept = New Collection
Dim deptInfo As Variant
Do While Not IsEmpty(Cells(currRow, DataColumns.DateTimeStamp))
Dim dept As String: dept = Cells(currRow, DataColumns.Department).Value
If DeptExists(maxDatesByDept, dept) Then
If Cells(currRow, DataColumns.DateTimeStamp).Value > maxDatesByDept.Item(dept)(DATETIME) Then
deptInfo = Array(Cells(currRow, DataColumns.UName).Value, Cells(currRow, DataColumns.DateTimeStamp).Value)
UpdateExistingEntry maxDatesByDept, deptInfo, Cells(currRow, DataColumns.Department)
End If
Else
deptInfo = Array(Cells(currRow, DataColumns.UName).Value, Cells(currRow, DataColumns.DateTimeStamp).Value)
maxDatesByDept.Add deptInfo, Cells(currRow, DataColumns.Department).Value
End If
currRow = currRow + 1
Loop
Set GetLastUpdater = maxDatesByDept
Set maxDatesByDept = Nothing
End Function
'//Since we are using the VBA collection object, there is no true
'//test for if an element exists; the collection will just throw
'//an error if you ask it for something it cannot find, so just
'//trap the error and return false in that case, as it means no
'//item was found in the list with that dept as it's key
Private Function DeptExists(ByRef deptList As Collection, dept As String) As Boolean
On Error GoTo handler
deptList.Item dept
DeptExists = True
Exit Function
handler:
Err.Clear
DeptExists = False
End Function
'//Updates an existing entry in our collection of dept users.
'//Note: this implementation allows for the trapping of failed attempts
'//but is not used in this version to keep it as straight-forward as
'//possible - If it was important to know when such attempts failed, you
'//could trap on the return value of this method and take the appropriate
'//action.
Private Function UpdateExistingEntry(ByRef deptList As Collection, ByVal deptInfo As Variant, ByVal dept As String) As Boolean
On Error GoTo handler
If DeptExists(deptList, dept) Then
deptList.Remove dept
deptList.Add deptInfo, dept
UpdateExistingEntry = True
Else
UpdateExistingEntry = False
End If
Exit Function
handler:
Err.Clear
UpdateExistingEntry = False
End Function