Auto insert date in two cells problem

[Tucup]

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

 

[DanteAmor]

Check if this helps you, otherwise, explain step by step what is the sequence you need.

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]

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.

 

[Tucup]

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]

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:

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:

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:

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]

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

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]

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:

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]

Try this:

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]

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.