How to reflect a date stamp log that does not overwrite the one before? - vba

Question

I have an Excel Sheet that I am using to track the status of hiring, where each row is a vacancy's record and one of the cells is a drop down list to change the status of that specific vacancy. Statuses are for example (Advertising, Interviewing, Hired)
What I wanted to do is once I click a status, by the end of the row (let's say last of my record here is Column S, so when I click advertising, a date stamp goes on S and the status itself gets printed there on Column T, and if I choose the 2nd status, it would go on Columns U & V and so on.
What I used so far is something different, that reflects the date stamp based on the corresponding column of that status:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim WorkRng As Range
Dim Rng As Range
Dim xOffsetColumn As Long
Set WorkRng = Intersect(Application.ActiveSheet.Range("H:H"), Target)
If Not WorkRng Is Nothing Then
Application.EnableEvents = False
For Each Rng In WorkRng
Select Case Rng.Value2
Case "Not-initiated"
xOffsetColumn = 100 'Column O
Case "Adv/Sourcing"
xOffsetColumn = 9 'Column U
Case "Interviewing"
xOffsetColumn = 10 'Column Q
Case "Offering & Selection"
xOffsetColumn = 11 'Column R
Case "Onboarding"
xOffsetColumn = 12 'Column S
Case "Contract Signed"
xOffsetColumn = 13 'Column U
Case "Joined"
xOffsetColumn = 14 'Column Q
Case Else
xOffsetColumn = 101 'Column T - entry not listed above
End Select
Rng.Offset(0, xOffsetColumn).Value = Now
Rng.Offset(0, xOffsetColumn).NumberFormat = "dd-mm-yyyy"
Next
Application.EnableEvents = True
End If
End Sub

Answer 1

If I understand properly, you want a Drop Down on each row, around column R, with 3 choices, that when selected will populate the cell 1, 2, or 3 cells to the right, with the current date.
What I would do is this: if I'm going to place a Drop Down on top of cell R2, then size it to be exactly the same as the cell* (see bottom of this answer) and hide the Cell Link right underneath it, $R2.
Assign a macro, pointing to this sub in a module:
Sub DropDown2_Change() '(all the drop downs call this sub, on change)
Dim dd As Shape, ddCell As String, ddValue As String, ddIndex As Integer
Set dd = ActiveSheet.Shapes(Application.Caller) 'shape object: the selected DropDown
ddValue = dd.ControlFormat.List(dd.ControlFormat.ListIndex) 'dropdown's new string value [not used]
ddCell = dd.ControlFormat.LinkedCell 'range object: the cell linked to the dropdown
ddIndex = ActiveSheet.Range(ddCell) 'selected index: 1=Advertised,2=Interviewed,3=Hired
Range(ddCell).Offset(0, ddIndex) = Date 'set date of cell 1,2,or 3 cells to the right
End Sub
Sometimes it can be a pain just getting the Drop Downs to line up with the cells properly (especially if you start moving around columns afterwards) but in the past I found it best to create & setup the Drop Downs programmatically, to ensure perfect alignment, correct naming, etc. (In fact, any time I do need to move them after that, I just delete and re-create them ALL, to save a headache.)
Depending on your needs you might be able to get away with copying the 1st completed, functioning Drop Down manually, and pasting it one by one into each cell below. Just make sure that the Cell Link is Abs/Rel like **$**B2 or else they all might default to the same Cell Link.
It's okay if they all share the same sub since the code above will check for the Cell Link of the changed Drop Down.
This way you won't have to mess around with WorkSheet_Change (which doesn't fire for Drop Down changes anyway).
You can download the test sheet I used from JumpShare here: tmpDropDowns.xlsm. (It views online but VBA won't work unless you download it.)
Let me know if you have any questions!
UPDATE:
To populate first empty cell to the right of the Drop Down with the Date + Status (as opposed to populating only columns S,T,U).
Updated Code:
Option Explicit
Sub DropDown2_Change() '(all the drop downs call this sub, on change)
Dim dd As Shape, ddCell As String, ddValue As String, ddIndex As Integer
Set dd = ActiveSheet.Shapes(Application.Caller) 'shape object: the selected DropDown
ddValue = dd.ControlFormat.List(dd.ControlFormat.ListIndex) 'dropdown's new string value
ddCell = dd.ControlFormat.LinkedCell 'range object: the cell linked to the dropdown
ddIndex = ActiveSheet.Range(ddCell) 'selected index: 1=Advertised,2=Interviewed,3=Hired [not used]
FirstEmptyCellToRight(Range(ddCell)) = ddValue & " " & Date 'set date of cell 1,2,or 3 cells to the right
End Sub
Function FirstEmptyCellToRight(cell_In As Range) As Range
'since ".End(xlToRight).Offset(0, 1)" wasn't working for me
'returns cell_In if it's blank, and if not then the first blank cell to the right
Set FirstEmptyCellToRight = cell_In
Do Until IsEmpty(FirstEmptyCellToRight) Or FirstEmptyCellToRight.Value = ""
Set FirstEmptyCellToRight = FirstEmptyCellToRight.Offset(0, 1)
Loop
End Function
Adding screenshot:
Updated File on JumpShare: tmpDropDowns.xlsm
(Must be downloaded; viewing online won't work with VBA.)