Date stamps based on cell value in VBA

B

birpal

New Member
Joined
Sep 13, 2016
Messages
10
Hi, I wanted to create an excel form that has a drop down menu in column A and time stamps in columns B to E (four). I wanted the time stamps to be entered for each column whenever the Column A' cell has been changed from the Drop down menu - which is Step 1, step 2 Step 3 and step 4. I wanted to record the process of when each entry has reached that step. Also make it so that the user cannot re-choose a step in which a date stamp has already been recorded, that way the date stamp won;t get altered.
 

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.
Sort by date Sort by votes
Hi give this a try. It uses the worksheet event.
I assume row 1 is the header. Range covered is from row 2 to 100. Change to suit your needs.
Click on any cell from A2 to A100 and a Data Validation will be created for that cell. It will have 4 options.
When you select one option, it will no longer be available for that row (unless you clear the time stamp). The code is quite long, maybe someone can help to reduce it.

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim tRow As Long
    Dim tCol As Long


    Application.EnableEvents = False
    On Error GoTo ErrorRoutine
    
    If Not Intersect(Target, Range("A2:A[B][COLOR=#ff0000]100[/COLOR][/B]")) Is Nothing Then
      tRow = Target.Row
      tCol = Target.Column
      Select Case True
        Case Target.Value = "Step 1"
          If Cells(tRow, tCol + 1) = "" Then
            Cells(tRow, tCol + 1) = Now
          End If
        Case Target = "Step 2"
          If Cells(tRow, tCol + 2) = "" Then
            Cells(tRow, tCol + 2) = Now
          End If
        Case Target = "Step 3"
          If Cells(tRow, tCol + 3) = "" Then
            Cells(tRow, tCol + 3) = Now
          End If
        Case Target = "Step 4"
          If Cells(tRow, tCol + 4) = "" Then
            Cells(tRow, tCol + 4) = Now
          End If
      End Select
      Call Worksheet_SelectionChange(Target)
    End If
    Application.EnableEvents = True
    Exit Sub
    
ErrorRoutine:
    Application.EnableEvents = True
End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("A2:A[B][COLOR=#ff0000]100[/COLOR][/B]")) Is Nothing Then
      Dim ValList As String


      Application.EnableEvents = False
      On Error GoTo ErrorRoutine
      ValList = ""
      For c = 1 To 4
        If Target.Offset(, c) = "" Then
          ValList = ValList & "Step " & c & ","
        End If
      Next
      With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=ValList
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
      End With
    End If
        Application.EnableEvents = True
    Exit Sub


ErrorRoutine:
    Application.EnableEvents = True


End Sub
 
Upvote 0
Thank you so much so far it works perfectly. Just if it is possible I would like to add a command button (Toggle style) so when it is enabled I can edit my step if need be. So I don't mistakenly clcik the wrong step. Also Is it possible to make it like after I click after a date stamp for " step 1" is created that I can now click step 2 in the same cell. I know this is not like data validation but it would make things more convenient.
 
Upvote 0
Also is it possible to to call each step : "Step 1: Arrived", "Step 2: Started", "Step 3: Finished", and "Step 4: Shipped"
 
Upvote 0
Hi birpal
If you accidentally selected the wrong option, just delete the time stamp and the option will be available again.
I have changed the code to show "Step 1: Arrived", "Step 2: Started", "Step 3: Finished", and "Step 4: Shipped"

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    'Coded by SunnyKow - 16/09/2016
    
    Dim tRow As Long
    Dim tCol As Long
    Dim sel As String

    Application.EnableEvents = False
    On Error GoTo ErrorRoutine
    
    'You can change the range here
    If Not Intersect(Target, Range("A2:A100")) Is Nothing Then
      tRow = Target.Row
      tCol = Target.Column
      sel = Left(Target, 6)
      
      Select Case True
        Case sel = "Step 1"
          If Cells(tRow, tCol + 1) = "" Then
            Cells(tRow, tCol + 1) = Now
          End If
        Case sel = "Step 2"
          If Cells(tRow, tCol + 2) = "" Then
            Cells(tRow, tCol + 2) = Now
          End If
        Case sel = "Step 3"
          If Cells(tRow, tCol + 3) = "" Then
            Cells(tRow, tCol + 3) = Now
          End If
        Case sel = "Step 4"
          If Cells(tRow, tCol + 4) = "" Then
            Cells(tRow, tCol + 4) = Now
          End If
      End Select
      'This update the validation list
      Call Worksheet_SelectionChange(Target)
    End If
    Application.EnableEvents = True
    Exit Sub
    
ErrorRoutine:
    Application.EnableEvents = True
End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    'Coded by SunnyKow - 16/09/2016

    If Not Intersect(Target, Range("A2:A100")) Is Nothing Then
      Dim ValList As String
      Dim c As Long

      Application.EnableEvents = False
      On Error GoTo ErrorRoutine
      ValList = ""
      For c = 1 To 4
        If Target.Offset(, c) = "" Then
          'You can change the validation list here
          ValList = ValList & Choose(c, "Step 1: Arrived", "Step 2: Started", "Step 3: Finished", "Step 4: Shipped") & ","
        End If
      Next
      'You can change the validation settings here
      With Selection.Validation
        'Remove the old validation list
        .Delete
        'Add the new validation list
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=ValList
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
      End With
    End If
        Application.EnableEvents = True
    Exit Sub

ErrorRoutine:
    Application.EnableEvents = True

End Sub

For your second request "Also Is it possible to make it like after I click after a date stamp for " step 1" is created that I can now click step 2 in the same cell". I don't quite understand what you wanted. I can only assume you wanted to click a cell to insert the time stamp. The codes below will insert the time stamp (provided the cell is blank) upon double-clicking the cell . Change the range to suit your needs.
Code: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    'Coded by SunnyKow - 16/09/2016

    Application.EnableEvents = False
    On Error GoTo ErrorRoutine

    'You can change the range here
    If Not Intersect(Target, Range("A2:D100")) Is Nothing Then
      'Update only if cell is empty
      If Target = "" Then
        Target = Now
      End If
      Cancel = True
    End If
    Application.EnableEvents = True
    Exit Sub

ErrorRoutine:
    Application.EnableEvents = True
End Sub



 
Upvote 0
First of all thank you so much. Secondly apologizes for repsonding so late i applied your revised code and found it more than sufficient in what I'm trying to do. All I edited was change the range from "a2:a100" to "k:K. The second thing I was asking was that I must select "Step 1" or in my case Step 1: Arrived, before I can select Step: 2 Starte, to prevent users from mistakenly selecting the wrong step.
 
Upvote 0
Hi
Try this
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    'Coded by SunnyKow - 19/09/2016
    
    Dim tRow As Long
    Dim tCol As Long
    Dim sel As String


    Application.EnableEvents = False
    On Error GoTo ErrorRoutine
    
    'You can change the range here
    If Not Intersect(Target, Range("K:K")) Is Nothing Then
      tRow = Target.Row
      tCol = Target.Column
      sel = Left(Target, 6)
      
      Select Case True
        Case sel = "Step 1"
          If Cells(tRow, tCol + 1) = "" Then
            Cells(tRow, tCol + 1) = Now
          End If
        Case sel = "Step 2"
          If Cells(tRow, tCol + 2) = "" Then
            Cells(tRow, tCol + 2) = Now
          End If
        Case sel = "Step 3"
          If Cells(tRow, tCol + 3) = "" Then
            Cells(tRow, tCol + 3) = Now
          End If
        Case sel = "Step 4"
          If Cells(tRow, tCol + 4) = "" Then
            Cells(tRow, tCol + 4) = Now
          End If
      End Select
      'This update the validation list
      Call Worksheet_SelectionChange(Target)
    End If
    Application.EnableEvents = True
    Exit Sub
    
ErrorRoutine:
    Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    'Coded by SunnyKow - 19/09/2016


    If Not Intersect(Target, Range("K:K")) Is Nothing Then
      Dim ValList As String
      Dim c As Long


      Application.EnableEvents = False
      On Error GoTo ErrorRoutine
      ValList = ""
      For c = 1 To 5
        If Target.Offset(, c) = "" Then
          'You can change the validation list here
          ValList = ValList & Choose(c, "Step 1: Arrived", "Step 2: Started", "Step 3: Finished", "Step 4: Shipped", "") & ","
          Exit For
        End If
      Next
      'Clear the validation cell
      Selection.ClearContents
      
      'You can change the validation settings here
      With Selection.Validation
        'Remove the old validation list
        .Delete
        'Add the new validation list
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=ValList
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
      End With
    End If
    
    Application.EnableEvents = True
    Exit Sub


ErrorRoutine:
    Application.EnableEvents = True


End Sub
 
Upvote 0
Nevermind I just cut "Selection.ClearContents" to ke the cell have the value. thank you its perfect.
 
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Question Question
Time and date stamp with drop down menu
Replies
0
Views
395
kmsprague
K
M
  • Question Question
[VBA]Copy data from specify cell and input value to another sheet with time stamp
Replies
2
Views
387
maiwarits
M
S
  • Question Question
VBA code to determine InDesign Layout
Replies
6
Views
377
Akuini
Akuini
C
  • Question Question
Custom Data Validation drop downs dependent on a cell value
Replies
5
Views
756
myall_blues
myall_blues
P
  • Question Question
Moving rows to different sheets based on drop down.
2
Replies
12
Views
979
purevega
P

Forum statistics

Threads
1,223,234
Messages
6,170,891
Members
452,366
Latest member
TePunaBloke

Share this page

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