CODEWITHSUNDEEP
excelvba
Red
Red

Reputation: 61

Generate date stamp when data entered

I am trying to create a nonvolatile date stamp in Column A cells as entries are made in B, C and D cells in the same row.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer
For i = 2 To 10000
    If Cells(i, “B”).Value <> “” And _
       Cells(i, “C”).Value <> “” And _
       Cells(i, “D”).Value <> “” And _
       Cells(i, “A”).Value = “” Then

        Cells(i, "A").Value = Date & " " & Time
        Cells(i, "A").NumberFormat = "m/d/yyyy h:mm AM/PM"
    End If
Next
Range("A:A").EntireColumn.AutoFit
End Sub

I made it go to 10000 for the simple fact I do not know how to tell it to go as long as entries are entered.

Upvotes: 0

Views: 153

Answers (2)

user11026105
user11026105

Reputation: 166

It appears that you want to receive a datestamp once columns B:D are filled and column A is still empty.

If you write values back to the worksheet, disable event handling and provide error control.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Range("B:D"), Target) Is Nothing Then
        On Error GoTo exit_handler
        Application.EnableEvents = False
        Dim r As Range
        For Each r In Intersect(Range("B:D"), Target).Rows
            If Cells(r.Row, "B").Value <> vbNullString And Cells(r.Row, "C").Value <> vbNullString And _
               Cells(r.Row, "D").Value <> vbNullString And Cells(r.Row, "A").Value = vbNullString Then
                Cells(i, "A").Value = Now
                Cells(i, "A").NumberFormat = "mm/dd/yyyy h:mm AM/PM"
            End If
        Next t
    End If

exit_handler:
    Application.EnableEvents = True

End Sub

Upvotes: 1

Ricardo A
Ricardo A

Reputation: 1815

Try this to get rid of the loop:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Integer
    If Target.Count = 1 And Target.Column > 1 And Target.Column < 5 Then
        If Cells(Target.Row, "B").Value <> "" And Cells(Target.Row, "C").Value <> "" And Cells(Target.Row, "D").Value <> "" And Cells(Target.Row, "A").Value = "" Then
            Cells(Target.Row, 1).Value = Now
            Cells(Target.Row, 1).NumberFormat = "m/d/yyyy h:mm AM/PM"
            Range("A:A").EntireColumn.AutoFit
        End If
    End If
End Sub

In short, when you make a change on column B C or D, it will check if All 3 for that Row are filled and then put the time stamp if it doesnt have one. Skipping the loop. If you are pasting data instead of typing it, it will not work, instead use the loop from Pawel's answer.

Upvotes: 0

Related Questions