Auto insert date in two cells problem

Tucup

New Member
Joined
Sep 25, 2018
Messages
6
Good afternoon,

I am really rubbish with VBA so please forgive my code errors. , I have a worksheet where I have a drop down list (A), once selected it puts the date and time in a cell, 2 cells to the right(C). In the same Row I have another cell(F), that if data is present, it puts the time into a cell, 2 cells to the left(D). As I add more rows, it is replicated as my list grows It was originally two separate scripts but due to an error I had to merge them. It worked for a while but now every time I click on a new Row, even with no data in (F) it puts the TIME in (D) and runs off down the page.
Can someone please help


Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'Updated by Tucup 2017/10/12
Dim xRg As Range, xCell As Range
On Error Resume Next
If (Target.Count = 1) Then
If (Not Application.Intersect(Target, Me.Range("A:A")) Is Nothing) Then _
Target.Offset(0, 2) = Now()
Application.EnableEvents = False
Set xRg = Application.Intersect(Target.Dependents, Me.Range("A:A"))
If (Not xRg Is Nothing) Then
For Each xCell In xRg
xCell.Offset(0, 2) = Now()
Next
End If
Application.EnableEvents = True
End If
Dim rInt As Range
Dim rCell As Range
Dim tCell As Range

Set rInt = Intersect(Target, Range("F:F"))
If Not rInt Is Nothing Then
For Each rCell In rInt
Set tCell = rCell.Offset(0, -2)
If IsEmpty(tCell) Then
tCell = Time
'tCell.NumberFormat = "hh:mm"
End If
Next
End If

End Sub
 

Some videos you may like

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,220
Office Version
2007
Platform
Windows
Check if this helps you, otherwise, explain step by step what is the sequence you need.


Code:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim c As Range
    If Not Intersect(Target, Range("A:A")) Is Nothing Then
        For Each c In Target
            c.Offset(0, 2) = Now()
        Next
    End If
    If Not Intersect(Target, Range("F:F")) Is Nothing Then
        For Each c In Target
            If c.Offset(0, -2) = "" Then c.Offset(0, -2) = Now()
        Next
    End If
End Sub
 

Tucup

New Member
Joined
Sep 25, 2018
Messages
6
Hi Dante,
Thanks for the quick reply. Here is a screen capture below. What I hoped to have is in the top section ( I have a button that copies data from a second worksheet to the main worksheet = DAY)
This is fine. What I get should be the middle section you see below. As I put data in (Column A dropdown list) the script should then detect data in that cell and put the date in Column C. Then when I move over to Column F and enter data, Column D gets the TIME inserted. Unfortunately, the part that controls F & D seems to populate the whole column.
 
Last edited by a moderator:

Tucup

New Member
Joined
Sep 25, 2018
Messages
6
Hi Dante,
Thanks for the quick reply.

Sorry I tried to include a screen capture and could not delete it.

What I was hoping for was to only put the date in if there was data in the corresponding cells. So if I put data (TEXT) into column A, column C would put the date in. Similarly, If data was put into F then the time would appear in D.

A B C D E F G
Hello 18.07.2019 18:45 Hello
18:49 Hello
Hello 19:07.2019


Does this seem plausible?
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,220
Office Version
2007
Platform
Windows
Hi Dante,
Thanks for the quick reply.

Sorry I tried to include a screen capture and could not delete it.

What I was hoping for was to only put the date in if there was data in the corresponding cells. So if I put data (TEXT) into column A, column C would put the date in. Similarly, If data was put into F then the time would appear in D.

A B C D E F G
Hello 18.07.2019 18:45 Hello
18:49 Hello
Hello 19:07.2019
Does this seem plausible?

If you are going to capture several data at the same time in the columns:

Code:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim c As Range
    If Not Intersect(Target, Range("A:A")) Is Nothing Then
        For Each c In Target
            Cells(c.Row, "C").Value = Date
        Next
    End If
    If Not Intersect(Target, Range("F:F")) Is Nothing Then
        For Each c In Target
            Cells(c.Row, "D").Value = Time
        Next
    End If
End Sub

----------------------------------------
If you only capture one data:

Code:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("A:A")) Is Nothing Then
        Cells(Target.Row, "C").Value = Date
    End If
    If Not Intersect(Target, Range("F:F")) Is Nothing Then
        Cells(Target.Row, "D").Value = Time
    End If
End Sub

---A variant:

Code:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("A:A, F:F")) Is Nothing Then
        If Target.Column = 1 Then Target.Offset(, 2) = Date Else Target.Offset(, -2) = Time
    End If
End Sub
 

Tucup

New Member
Joined
Sep 25, 2018
Messages
6
If you are going to capture several data at the same time in the columns:

Code:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim c As Range
    If Not Intersect(Target, Range("A:A")) Is Nothing Then
        For Each c In Target
            Cells(c.Row, "C").Value = Date
        Next
    End If
    If Not Intersect(Target, Range("F:F")) Is Nothing Then
        For Each c In Target
            Cells(c.Row, "D").Value = Time
        Next
    End If
End Sub

I like this very much. I still get an error though. Even though there is no data in the cells, it still puts the date and time in. I think it sees copied range of empty cells as a form or data even though it has no text in it. Sorry to take up your time. Is it possible to only insert Date & Time if no text is in the cell? No Date or Time if the cell has no text.



Tucup
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,220
Office Version
2007
Platform
Windows
I like this very much.

I still get an error though. What error message does the macro send and on which line does it stop?


Is it possible to only insert Date & Time if no text is in the cell? If there is no text, in which cell? in the destination cells (columns C and D)? Or in the modified cells columns (A and F)?

Tucup
Try this:

Code:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("A:A")) Is Nothing Then
        If Cells(Target.Row, "C").Value = "" Then Cells(Target.Row, "C").Value = Date
    End If
    If Not Intersect(Target, Range("F:F")) Is Nothing Then
        If Cells(Target.Row, "D").Value = "" Then Cells(Target.Row, "D").Value = Time
    End If
End Sub
 

Tucup

New Member
Joined
Sep 25, 2018
Messages
6
Try this:

Code:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("A:A")) Is Nothing Then
        If Cells(Target.Row, "C").Value = "" Then Cells(Target.Row, "C").Value = Date
    End If
    If Not Intersect(Target, Range("F:F")) Is Nothing Then
        If Cells(Target.Row, "D").Value = "" Then Cells(Target.Row, "D").Value = Time
    End If
End Sub
Wow.... I have just got home and saw your reply. Fantastic, it works great. I have tried to force it to break but it is stable thanks to you DanteAmor.
Thankyou.
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,220
Office Version
2007
Platform
Windows
Wow.... I have just got home and saw your reply. Fantastic, it works great. I have tried to force it to break but it is stable thanks to you DanteAmor.
Thankyou.
I'm glad to help you. Thanks for the feedback.
 

Watch MrExcel Video

Forum statistics

Threads
1,102,782
Messages
5,488,850
Members
407,658
Latest member
Arias610

This Week's Hot Topics

  • Timer in VBA - Stop, Start, Pause and Reset
    [CODE=vba][/CODE] Option Explicit Dim CmdStop As Boolean Dim Paused As Boolean Dim Start Dim TimerValue As Date Dim pausedTime As Date Sub...
  • how to updates multiple rows in muliselect listbox
    Hello everyone. I need help with below code. code is only chaning 1st row in mulitiselect list box. i know issue with code...
  • Delete Row from Table
    I am trying to delete a row from a table using VBA using a named range to find what I need to delete. My Range is finding the right cell. In the...
  • Assigning to a variable
    I have a for each block where I want to assign the value in column 5 of the found row to the variable Serv. [CODE=vba] For Each ws In...
  • Way to verify information
    Hi All, I don't know what to call this formula, and therefore can't search. I have a spreadsheet with information I want to reference...
  • Active Cell Address – Inactive Sheet
    How to use VBA to get the cell address of the active cell in an inactive worksheet and then place that cell address in a location on the current...
Top