Auto insert date in two cells problem
Results 1 to 9 of 9

Thread: Auto insert date in two cells problem
Thanks Thanks: 0 Likes Likes: 0

  1. #1
    New Member
    Join Date
    Sep 2018
    Posts
    6
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Auto insert date in two cells problem

    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

  2. #2
    Board Regular DanteAmor's Avatar
    Join Date
    Dec 2018
    Location
    México
    Posts
    5,263
    Post Thanks / Like
    Mentioned
    49 Post(s)
    Tagged
    14 Thread(s)

    Default Re: Auto insert date in two cells problem

    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
    Regards Dante Amor

  3. #3
    New Member
    Join Date
    Sep 2018
    Posts
    6
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Auto insert date in two cells problem

    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 Fluff; Jul 18th, 2019 at 12:52 PM. Reason: Removed failed image code

  4. #4
    New Member
    Join Date
    Sep 2018
    Posts
    6
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Auto insert date in two cells problem

    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?

  5. #5
    Board Regular DanteAmor's Avatar
    Join Date
    Dec 2018
    Location
    México
    Posts
    5,263
    Post Thanks / Like
    Mentioned
    49 Post(s)
    Tagged
    14 Thread(s)

    Default Re: Auto insert date in two cells problem

    Quote Originally Posted by Tucup View Post
    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
    Regards Dante Amor

  6. #6
    New Member
    Join Date
    Sep 2018
    Posts
    6
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Auto insert date in two cells problem

    Quote Originally Posted by DanteAmor View Post
    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

  7. #7
    Board Regular DanteAmor's Avatar
    Join Date
    Dec 2018
    Location
    México
    Posts
    5,263
    Post Thanks / Like
    Mentioned
    49 Post(s)
    Tagged
    14 Thread(s)

    Default Re: Auto insert date in two cells problem

    Quote Originally Posted by Tucup View Post
    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
    Regards Dante Amor

  8. #8
    New Member
    Join Date
    Sep 2018
    Posts
    6
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Auto insert date in two cells problem

    Quote Originally Posted by DanteAmor View Post
    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.

  9. #9
    Board Regular DanteAmor's Avatar
    Join Date
    Dec 2018
    Location
    México
    Posts
    5,263
    Post Thanks / Like
    Mentioned
    49 Post(s)
    Tagged
    14 Thread(s)

    Default Re: Auto insert date in two cells problem

    Quote Originally Posted by Tucup View Post
    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.
    Regards Dante Amor

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •