Time Stamp with initials from dropdown box value

Steve1977

New Member
Joined
May 16, 2019
Messages
33
Currently I have an Excel file which enters a time stamp depending on if a value is entered in Column A. So it looks like this

Column AColumn BColumn C
Data<where value="" is="" entered<<="" td=""></where>Blank<blank for="" now=""></blank>A Date Stamp auto fills when
something is entered in Column A

<tbody>
</tbody>

For this to work I have the following code in Sheet 1:

Code:
Private Sub Worksheet_Change(ByVal Target As Range)

'Specifies Column A
If Target.Column <> 1 Then Exit Sub
If Target.Cells.Count > 1 Then Exit Sub
'Specifies the Target as Column C. If Above code specified 5 (i.e. Column E), 2 below would put data in Column G
With Target.Offset(0, 2)
.Value = Now
.NumberFormat = "MM/DD/YYYY hh:mm AM/PM"


End With




End Sub


I also have a Drop Down Box which is populated with values in Sheet 2.


Question 1: The User will specify a value in a dropdown box prior to entering but how can I ensure this value, auto goes into a separate cell (on the same row) - i.e. H1

Question 2: If a user does try to edit the file without selecting a value in dropdown box, I want it to be impossible to edit.

Question 3: How could I amend the code to include more than one column? i.e. if Column A is changed it puts date stamp, but I want it so if Column B is also changed it updates date stamp.


Thank you for any help in advance :)
 
Last edited:

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
1 -
Code:
Cells(Target.Row, "H").Value = Range("M2").Value
where M2 is the dropdown cell.

2 - You would have to protect the sheet, then unlock columns A:B in the Worksheet_Change when the dropdown cell is changed.

3 -
Code:
If Not Intersect(Target, Columns("A:B")) Is Nothing Then
a cell in column A or B has changed.
 
Upvote 0
Thank you John :)

I am still struggling a bit tbh...where you say M2 is the Dropdown, Cell...is that the cell where the value from the dropdown box would go or the name of the Drop Down Box?
I did manage to get the value in a cell of it's own by using LinkedCell in Proprties.
Ideally it would be spot on if it exported the value in the combobox, but only if a row was edited and it would only insert the value on that same row (which has been edited)


3) Would this go with the existing code? I tried to insert it but had compilation errors unfortunately.


Appreciate your help :)
 
Last edited:
Upvote 0
My thought was that your dropdown is a data-validation in-cell dropdown and M2 is the cell containing the dropdown. It sounds like you're using a combo box form control. In your case, I think a data validation dropdown cell is better because it is easier to handle than the linked cell for a combo box in the Worksheet_Change event.

See if the following works as you require.

First, manually add a Data Validation dropdown to cell M2 on your data entry sheet (Sheet1). This should be a List, with the Source referencing the initials in cells on Sheet2. The first value in the list on Sheet2 should be something like "Select initials", so that this appears as the first item in the dropdown.

Add this to a standard module:
Code:
Option Explicit

Public Const Lock_Cells_Password As String = "EXCEL"

Public DropdownCell As Range
Public DropdownListSource As Range
    
    
Public Sub Set_Dropdown_Cell()
    Set DropdownCell = Worksheets("Sheet1").Range("M2")
    Set DropdownListSource = Evaluate(DropdownCell.Validation.Formula1)
End Sub

Public Sub Lock_Columns()
    Worksheets("Sheet1").Columns("A:B").Locked = True
    Worksheets("Sheet1").Protect Password:=Lock_Cells_Password, UserInterfaceOnly:=True
End Sub

Public Sub Unlock_Columns()
    Worksheets("Sheet1").Unprotect Password:=Lock_Cells_Password
    Worksheets("Sheet1").Columns("A:B").Locked = False
End Sub

Public Sub Protect_Sheet()
    ActiveSheet.Protect Password:=Lock_Cells_Password, DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

Public Sub Unprotect_Sheet()
    ActiveSheet.Unprotect Password:=Lock_Cells_Password
End Sub

And here is the modified Worksheet_Change for the Sheet1 module:

Code:
Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Cells.Count > 1 Then Exit Sub
    
    If DropdownCell Is Nothing Then Set_Dropdown_Cell
    
    If DropdownCell.Value <> DropdownListSource.Item(1).Value Then
    
        If Not Intersect(Target, DropdownCell) Is Nothing Then
        
            'Dropdown was changed, so unlock columns A:B to allow user input in them
            
            Unlock_Columns

        ElseIf Not Intersect(Target, Columns("A:B")) Is Nothing Then
        
            'Cell in columns A:B was changed, so put timestamp in column C and current dropdown value in column H
            
            With Cells(Target.Row, "C")
                .Value = Now
                .NumberFormat = "MM/DD/YYYY hh:mm AM/PM"
            End With
            Cells(Target.Row, "H").Value = DropdownCell.Value
            
            'Reset dropdown value to first in list, triggering this event which will call Lock_Columns
            
            DropdownCell.Value = DropdownListSource(1).Value

        End If
        
    Else
    
        Lock_Columns
        
    End If

End Sub
Put this in the ThisWorkbook module:
Code:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    
    If DropdownCell Is Nothing Then Set_Dropdown_Cell
    Application.EnableEvents = False
    DropdownCell.Value = DropdownListSource(1).Value
    Application.EnableEvents = True
    Lock_Columns

End Sub
Finally, run the Protect_Sheet macro. You should now find that you can't change any cells on Sheet1. If you select one of the initials in the dropdown, you should be able to enter a value in any cell in column A and B and it puts the timestamp in column C and the initials in column H on the same row. The dropdown then changes to "Select initials" and locks the sheet, preventing any changes.

You can run the Unprotect_Sheet macro if you need to change any cells on Sheet1, for setup purposes.
 
Upvote 0

Forum statistics

Threads
1,213,538
Messages
6,114,218
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top