Macros to triggger timestamp whenever one specific option is selected from the drop down list

Marta1

New Member
Joined
Jan 14, 2023
Messages
16
Office Version
  1. 2019
Platform
  1. Windows
Hi All,

Hope you are doing great

I need your help to create a Macros to trigger timestamp whenever one specific option is selected from the drop down list

I have a file called Employee(Copy) where is already a event macros to copy and paste the values in the another file. So, I wanted to add addition features to this sheet without disturbing the existed code but I am bit lost.

Whenever the status is changed to "In progress" then macros should add the current time stamp in the column "In progress start" and once the "In progress" status gets changed to another status then macros should create a time stamp in the column "In progress end"

Could you please help me with this? :)

Please have a look at the attached photos

Thank you in Advance

Regards
Marta
 

Attachments

  • Screenshot 2023-03-03 084026.png
    Screenshot 2023-03-03 084026.png
    71.8 KB · Views: 26
  • Screenshot 2023-03-03 084114.png
    Screenshot 2023-03-03 084114.png
    53.5 KB · Views: 26

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
Hi,
Would be helpful if you would post your current Event macro ... in order to amend it ...;)
 
Upvote 0
Hi James,

Thank you for the reply, please find the code below

Private Sub Worksheet_Change(ByVal Target As Range)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Event macro to be placed in your Source Workbook
' As soon as User fills in data in Column E
' and your two conditions are fulfilled , New record is copied
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim i As Long, lastrow As Long
Dim wksh1 As Worksheet, wksh2 As Worksheet
If Target.Count > 1 Then Exit Sub
If Target.Column <> 7 Then Exit Sub
i = Target.Row
Set wksh1 = ThisWorkbook.Sheets("Sheet1")
' Adjust to your specific situation for Destination Names :
' Workbook Name AND Worksheet Name
Set wksh2 = Workbooks("Employee(final).xlsx").Sheets("Sheet1")

lastrow = wksh2.Cells(Rows.Count, "A").End(xlUp).Row + 1
If Target.Offset(0, -4).Value >= 43586 Then
If Target.Offset(0, -3).Value = "Charles" Or Target.Offset(0, -3).Value = "Nicolas" Then
If Target.Offset(0, 0).Value = "Completed" Then
' All tests Passed - Copy Record and Add Flag next to copied record
Target.Offset(0, 1).Font.Name = "Wingdings"
Target.Offset(0, 1).Value = "ü"
wksh1.Range("A" & i & ":G" & i).Copy Destination:=wksh2.Range("A" & lastrow)
End If
End If
End If
End Sub


Thank you
Regards
Marta
 
Upvote 0
Hi,
To be tested
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Event macro to be placed in your Source Workbook
' As soon as User fills in the Status in Column G
' and your two conditions are fulfilled , New record is copied
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim i As Long, lastrow As Long
Dim wksh1 As Worksheet, wksh2 As Worksheet
If Target.CountLarge > 1 Then Exit Sub
If Target.Column <> 7 Then Exit Sub
i = Target.Row
Set wksh1 = ThisWorkbook.Sheets("Sheet1")
' Adjust to your specific situation for Destination Names :
' Workbook Name AND Worksheet Name
Set wksh2 = Workbooks("Employee(final).xlsx").Sheets("Sheet1")

lastrow = wksh2.Cells(Rows.Count, "A").End(xlUp).Row + 1
    If Target.Offset(0, -4).Value >= 43586 Then
        If Target.Offset(0, -3).Value = "Charles" Or Target.Offset(0, -3).Value = "Nicolas" Then
          Select Case Target
            Case "In Progress"
              Target.Offset(0, 2) = Date
            ' Adjust with your specific identifier and replace the choice Advanced ''''''''''''''
            Case "Advanced"
                Target.Offset(0, 3) = Date
            Case "Completed"
                ' All tests Passed - Copy Record and Add Flag next to copied record '''''''''''''
                Target.Offset(0, 1).Font.Name = "Wingdings"
                Target.Offset(0, 1).Value = "ü"
                wksh1.Range("A" & i & ":G" & i).Copy Destination:=wksh2.Range("A" & lastrow)
          End Select
        End If
    End If
End Sub
 
Upvote 0
Hi James,

Thank you so much for your time :)

Actually, I don't need to apply any conditions for the status " In progress", So whenever I select the "In progress" in the column "Status" , I would like to see the time stamp in the column "In progress start" and once the "In progress" status gets changed to another status then macros should create a time stamp in the column "In progress end".

Sorry it is my bad that i didn't explain it thoroughly in the first place,

Could you please help me? :)

Thank you

Regards
Marta
 
Upvote 0
Hi again,
Hope following is more adapted to your request :
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Event macro to be placed in your Source Workbook
' As soon as User fills in the Status in Column G
' and your two conditions are fulfilled , New record is copied
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim i As Long, lastrow As Long
Dim wksh1 As Worksheet, wksh2 As Worksheet
If Target.CountLarge > 1 Then Exit Sub
If Target.Column <> 7 Then Exit Sub
i = Target.Row
Set wksh1 = ThisWorkbook.Sheets("Sheet1")
' Adjust to your specific situation for Destination Names :
' Workbook Name AND Worksheet Name
Set wksh2 = Workbooks("Employee(final).xlsx").Sheets("Sheet1")

lastrow = wksh2.Cells(Rows.Count, "A").End(xlUp).Row + 1
    If Target.Offset(0, -4).Value >= 43586 Then
        If Target.Offset(0, -3).Value = "Charles" Or Target.Offset(0, -3).Value = "Nicolas" Then
            If Not IsEmpty(Target.Offset(0, 2)) Then
                Target.Offset(0, 3) = Date
            Else
                Select Case Target
                  Case "In Progress"
                    Target.Offset(0, 2) = Date
                  Case "Completed"
                      ' All tests Passed - Copy Record and Add Flag next to copied record '''''''
                      Target.Offset(0, 1).Font.Name = "Wingdings"
                      Target.Offset(0, 1).Value = "ü"
                      wksh1.Range("A" & i & ":G" & i).Copy Destination:=wksh2.Range("A" & lastrow)
                End Select
            End If
        End If
    End If
End Sub
 
Upvote 0
Solution
Hi James,

Thank you so much, it works!!! :love:

You are amazing :)

Have a lovely weekend

Regards
Marta
 
Upvote 0
Hi James,

Hope you are doing great,

I just modified your code little bit and I need your help to add some more features here,

Once the time stamp is added to the column In progress start 1 and In progress end 1 then if i select ' In progress' status for the next time i would like to have the time stamp in the column In progress start 2 and else in column 'In progress end 2' without changing the data in the previous two columns In progress start 1 and In progress end 1

Could you please help me with this? :)

Regards
Marta

Here is the code
Private Sub Worksheet_Change(ByVal Target As Range)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Event macro to be placed in your Source Workbook
' As soon as User fills in data in Column E
' and your two conditions are fulfilled , New record is copied
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim i As Long, lastrow As Long
Dim wksh1 As Worksheet, wksh2 As Worksheet
If Target.Count > 1 Then Exit Sub
If Target.Column <> 7 Then Exit Sub
i = Target.Row
Set wksh1 = ThisWorkbook.Sheets("Sheet1")
' Adjust to your specific situation for Destination Names :
' Workbook Name AND Worksheet Name
Set wksh2 = Workbooks("Employee(final).xlsx").Sheets("Sheet1")

lastrow = wksh2.Cells(Rows.Count, "A").End(xlUp).Row + 1
If Target.Offset(0, -4).Value >= 43586 Then
If Target.Offset(0, -3).Value = "Charles" Or Target.Offset(0, -3).Value = "Nicolas" Then
If Target.Offset(0, 0).Value = "Completed" Then
' All tests Passed - Copy Record and Add Flag next to copied record
Target.Offset(0, 1).Font.Name = "Wingdings"
Target.Offset(0, 1).Value = "ü"
wksh1.Range("A" & i & ":G" & i).Copy Destination:=wksh2.Range("A" & lastrow)
End If
End If
End If
If Target.Column = 7 Then
Select Case Target
Case "In progress"
Cells(Target.Row, 9).Value = Date + Time

Case Else
Cells(Target.Row, 10).Value = Date + Time

End Select
End If
End Sub






 

Attachments

  • Screenshot 2023-03-06 163655.png
    Screenshot 2023-03-06 163655.png
    28.4 KB · Views: 6
Upvote 0
In order to avoid some confusion between all your "In Progress" status ... you should consider adding a new choice such as "Under Way" ...
 
Upvote 0
Hi James,

Thank you for the suggestion, I really appreciate that.

Actually, It is kind of important to have those multiple in progress time tracking columns in order to calculate the days between the start and end date. Could you please help me to modify the code accordingly? :)

Thanks for your help in Advance :)
 
Upvote 0

Forum statistics

Threads
1,215,507
Messages
6,125,201
Members
449,214
Latest member
mr_ordinaryboy

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