Automatic Date & Time VBA code

[Jagat Pavasia]

Dear Sir,

I want to auto date and time in format "dd/mm/yy hh:mm AM/PM"

My data is in from D7:J2500 and L7:M2500. (When I type in this column and Raws)

I want auto date in R7:X2500 and Y7:Z2500. (Auto Date Here)

For Example :
if I type in D7 then auto date and time in R7,
I type in E7 then auto date and time in S7
I type in L7 then auto date and time in Y7

send me VBA code, please

 

[ranman256]

range("S7").value = now()

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target = Range("e7") Then Range("s7").Value = Now()
End Sub

 

[Jagat Pavasia]

range("S7").value = now()

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target = Range("e7") Then Range("s7").Value = Now()
End Sub

Not Working Dear

 

[ranman256]

did you go into VBE (alt-f11)
then at top of screen: left combo, select Workbook
then in right right combo , select Sheet change
THEN paste the : range("S7").value = now()

 

[Jagat Pavasia]

did you go into VBE (alt-f11)
then at top of screen: left combo, select Workbook
then in right right combo , select Sheet change
THEN paste the : range("S7").value

did you go into VBE (alt-f11)
then at top of screen: left combo, select Workbook
then in right right combo , select Sheet change
THEN paste the : range("S7").value = now()

dear also do same but did not any answer in target column

 

[Jagat Pavasia]

range("S7").value = now()

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target = Range("e7") Then Range("s7").Value = Now()
End Sub

I think this type of data

Dim WorkRng As Range
    Dim Rng As Range
    Dim xOffsetColumn As Integer


    Set WorkRng = Intersect(Application.ActiveSheet.Range("D6:D9999,F6:F9999,H6:H9999,J6:J9999,L6:L9999,N6:N9999"), Target)
    xOffsetColumn = 1
    If Not WorkRng Is Nothing Then
        Application.EnableEvents = False
        On Error GoTo exit_proc
        Me.Unprotect
        For Each Rng In WorkRng
            If Not VBA.IsEmpty(Rng.Value) Then
                Rng.Offset(0, xOffsetColumn).Value = Now
                Rng.Offset(0, xOffsetColumn).NumberFormat = "dd/mm/yy  hh:mm AM/PM"
            Else
                Rng.Offset(0, xOffsetColumn).ClearContents
            End If
        Next
        Application.EnableEvents = True
    End If

 

[mumps]

Try:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Intersect(Target, Range("D:J ,L:M")) Is Nothing Then Exit Sub
    Select Case Target.Column
        Case 4 To 10
            With Target.Offset(, 14)
                .Value = Now()
                .NumberFormat = "dd/mm/yy  hh:mm AM/PM"
            End With
        Case Is = 12, 13
            With Target.Offset(, 13)
                .Value = Now()
                .NumberFormat = "dd/mm/yy  hh:mm AM/PM"
            End With
    End Select
    Application.ScreenUpdating = False
End Sub

 

[Jagat Pavasia]

Try:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Intersect(Target, Range("D:J ,L:M")) Is Nothing Then Exit Sub
    Select Case Target.Column
        Case 4 To 10
            With Target.Offset(, 14)
                .Value = Now()
                .NumberFormat = "dd/mm/yy  hh:mm AM/PM"
            End With
        Case Is = 12, 13
            With Target.Offset(, 13)
                .Value = Now()
                .NumberFormat = "dd/mm/yy  hh:mm AM/PM"
            End With
    End Select
    Application.ScreenUpdating = False
End Sub

Yes, it is working as I expected,

but when I remove my text then date and time is remained as it is.
I want that if I remove text in source column than it is also removed date and time in target column.

 

[mumps]

Try:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Intersect(Target, Range("D:J ,L:M")) Is Nothing Then Exit Sub
    Select Case Target.Column
        Case 4 To 10
            If Target <> "" Then
                With Target.Offset(, 14)
                    .Value = Now()
                    .NumberFormat = "dd/mm/yy  hh:mm AM/PM"
                End With
            Else
                Target.Offset(, 14).ClearContents
            End If
        Case Is = 12, 13
            If Target <> "" Then
                With Target.Offset(, 13)
                    .Value = Now()
                    .NumberFormat = "dd/mm/yy  hh:mm AM/PM"
                End With
            Else
                 Target.Offset(, 13).ClearContents
            End If
    End Select
    Application.ScreenUpdating = False
End Sub

 

[Jagat Pavasia]

Try:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Intersect(Target, Range("D:J ,L:M")) Is Nothing Then Exit Sub
    Select Case Target.Column
        Case 4 To 10
            If Target <> "" Then
                With Target.Offset(, 14)
                    .Value = Now()
                    .NumberFormat = "dd/mm/yy  hh:mm AM/PM"
                End With
            Else
                Target.Offset(, 14).ClearContents
            End If
        Case Is = 12, 13
            If Target <> "" Then
                With Target.Offset(, 13)
                    .Value = Now()
                    .NumberFormat = "dd/mm/yy  hh:mm AM/PM"
                End With
            Else
                 Target.Offset(, 13).ClearContents
            End If
    End Select
    Application.ScreenUpdating = False
End Sub
[SIZE=5][COLOR=rgb(147, 101, 184)]

[/COLOR][/SIZE]

THANK YOU SO MUCH MY DEAR........