Macros Timestamp

0

Please Help, need to timestamp with no recheck on Column H and J

HELP! My First Macros!

Code_Goes_Here

Private Sub TimeStamp(ByVal Target As Range)

Dim myGEMINSN As Range

Dim myTimeRangeIN As Range

Dim myGEMOUTSN As Range

Dim myTimeRangeOUT As Range

'Your data table range

Set myTimeRangeIN = Range("G4:G50")

Set myTimeRangeOUT = Range("I4:I50")

'Check if the changed cell is in the data tabe or not.

If Intersect(Target, myTimeRangeIN) Is Nothing Then Exit Sub

If Intersect(Target, myTimeRangeOUT) Is Nothing Then Exit Sub

'Stop events from running

Application.EnableEvents = False

'Column for the date/time

Set myTimeRangeIN = Range("H" & Target.Row)

Set myTimeRangeOUT = Range("J" & Target.Row)

'Determine if the input date/time should change

If myDateTimeRange.Value = "" Then

    myDateTimeRange.Value = Now

End If

'Turn events back on

Application.EnableEvents = True

End Sub

Answer
Discuss

Discussion

Jose

Please see my answer beow but for future question, it really helps if you provide an Excel file.

Also, when providing code in a question, you were right to press the code button but need to replace the bit "Code_Goes_Here" (within the ][  square brackets) with your code- that way it appears as the codes in my Answer below (and others can click the "Select All" header then copy the code). 
John_Ru (rep: 502) Jan 8, '21 at 3:16 am
Add to Discussion

Answers

0

Jose

I think you have tried to modify the macro from Don's tutorial Automatically Timestamp Entries in Excel to add a date stamp :

  1. for "In" in column H when something is typed in column G
  2. for "Out" in column J when something is typed in column I.

If so, the code in the attached file (and shown below) will do that. I've left the structure similar to the tutorial's macro but renamed the variables to GemIn (which adds a stamp in DateTimeIn) and GemOut (giving DateTimeOut)- see bold Dim statements in code below. (Note that is you change the names of variables, be sure that the new names are elsewhere in the macro or it won't work).

Because you want to do things in two columns, my code firstly checks and does something if a change was made in the GemIn range (commented in bold in the code below) then separately do similar forGemOut. Those checks are made by adding NOT in front of the Intersect statement like this:

If Not Intersect(Target, GemIn) Is Nothing Then

which is equivalent to asking "Is there an Intersect between the cell and the range?"

You made a good attempt at your first macro but there are two main errors:

  1. the automatic action is a special "Event" in Excel and you can't change the macro name (as I think you did) or the event won't be seen by Excel
  2. even if you kept the correct Event macro name, two lines in your code would stop it doing anything. The lines:
    If Intersect(Target, myTimeRangeIN) Is Nothing Then Exit Sub
    If Intersect(Target, myTimeRangeOUT) Is Nothing Then Exit Sub
     mean that if G4 was the changed cell, it would skip the first line but then it would NOT be in your myTimeRangeOUT (Column H) so it would exit the sub. A single cell can't be in two columns at once so that yowould always happen!

Anyway, the code you need is below hopefully. Good luck!

Private Sub Worksheet_Change(ByVal Target As Range)
'Timestamp for In and Out events
'   Based on tutorial from TeachExcel.com

Dim GemIn As Range
Dim DateTimeIn As Range
Dim GemOut As Range
Dim DateTimeOut As Range

'Your data table range
Set GemIn = Range("G4:G50")
Set GemOut = Range("I4:I50")

'Stop events from running
Application.EnableEvents = False

'Check if the changed cell is in the In column or not.
If Not Intersect(Target, GemIn) Is Nothing Then
    'Column for the In date/time
    Set DateTimeIn = Range("H" & Target.Row)
    ' Add the In date/time
    DateTimeIn.Value = Now
End If

'Check if the changed cell is in the Out column or not.
If Not Intersect(Target, GemOut) Is Nothing Then
    'Column for the In date/time
    Set DateTimeOut = Range("J" & Target.Row)
    ' Add the Out date/time
    DateTimeOut.Value = Now
End If

'Turn events back on
Application.EnableEvents = True

End Sub
Discuss


Answer the Question

You must create an account to use the forum. Create an Account or Login