Came back round, and see that no one has posted a VBA solution yet. Figured I would put one out there.
'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
'//Uses the created collection of dept, username to add the
'//required username to the column
Private Sub AppendLastUserName(dataStartRow As Long, deptListing As Collection)
Dim currRow As Integer: currRow = dataStartRow
Do While Not IsEmpty(Cells(currRow, DataColumns.DateTimeStamp))
Dim currDept As String: currDept = Cells(currRow, DataColumns.Department)
Cells(currRow, DataColumns.LastUpdater).Value = deptListing(currDept)(USERNAME)
currRow = currRow + 1
Loop
End Sub
This code will place the username of the last person to update the system within the context of the department.
Note that is assumes some things, such as the column locations; There is an Enumeration being used to reference the relevant columns, so you can point them to the proper column indexes if they differ from the example and all should work as expected. It also assumes that the column containing the datestamp has no gaps, and is always a date.
Copy and paste the entire set of code into a single module in excel and it will work just fine.