Add date to column when another cell is updated

[Hydestone]

I want the date in column F to update when I update information in column G.

This piece of VBA isn't working for me...any ideas on how to rewrite it?

Case Is = 7
If Target.Offset(, -1) = "" Then Target.Offset(, -1) = Date

Here is entire code on sheet.

Option Compare Text
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("A:A,C:C")) Is Nothing Then Exit Sub
    Dim LastRow As Long
    LastRow = Sheets("Open").Range("C" & Rows.Count).End(xlUp).Row + 1
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    Select Case Target.Column
        Case Is = 1
            If Target = "X" And Target.Offset(, 10) = "" Then
                Target.Offset(0, 10) = Date
                Rows(Target.Row).EntireRow.Copy Sheets("Closed").Cells(Sheets("Closed").Rows.Count, "A").End(xlUp).Offset(1, 0)
            ElseIf Target = "" Then
                Rows(Target.Row).EntireRow.Copy Sheets("Open").Cells(LastRow, 1)
            End If
        Case Is = 3
            If Target.Offset(, -1) = "" Then Target.Offset(, -1) = Date
        Case Is = 7
            If Target.Offset(, -1) = "" Then Target.Offset(, -1) = Date
    End Select
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

 

[Hydestone]

Something funky is going on...the code works, then all of a sudden it doesn't. The copy items when closed worked, but now doesn't. Also, populating the date when something entered in column C no longer works. Here is current code:

Option Compare Text
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("A:A,C:C,G:G")) Is Nothing Then Exit Sub
    Dim LastRow As Long
    LastRow = Sheets("Open").Range("C" & Rows.Count).End(xlUp).Row + 1
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    Select Case Target.Column
        Case Is = 1
            If Target.CountLarge > 1 Then Exit Sub
            If Target = "X" And Target.Offset(, 10) = "" Then
                Target.Offset(0, 10) = Date
                Rows(Target.Row).EntireRow.Copy Sheets("Closed").Cells(Sheets("Closed").Rows.Count, "A").End(xlUp).Offset(1, 0)
            ElseIf Target = "" Then
                Rows(Target.Row).EntireRow.Copy Sheets("Open").Cells(LastRow, 1)
            End If
        Case Is = 3
            If Target.Offset(, -1) = "" Then Target.Offset(, -1) = Date
        Case Is = 7
            If Target.Offset(, -1) = "" Then Target.Offset(, -1) = Date
    End Select
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

 

[Fluff]

Are you copy/pasting into multiple cells, or will you only update cell by cell?

 

[Hydestone]

Added it in there as the 4th line down, seems to be working!

 

[Hydestone]

I update the lines one at a time...no copying down or copy/pasting multiples.

I delete multiple at a time.

 

[Fluff]

I would normally put that line as the very first line of code, but as long as it's before the

With Application

line, all should be ok.

 

[Hydestone]

OK, I moved it up to the 3rd line.

If I wanted to remove the functionality of copying stuff to the Open worksheet, which lines could I safely remove?

  Option Compare TextPrivate Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Intersect(Target, Range("A:A,C:C,G:G")) Is Nothing Then Exit Sub
[COLOR=#ff0000]    Dim LastRow As Long[/COLOR]
[COLOR=#ff0000]    LastRow = Sheets("Open").Range("C" & Rows.Count).End(xlUp).Row + 1[/COLOR]
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    Select Case Target.Column
        Case Is = 1
            If Target = "X" And Target.Offset(, 10) = "" Then
                Target.Offset(0, 10) = Date
                Rows(Target.Row).EntireRow.Copy Sheets("Closed").Cells(Sheets("Closed").Rows.Count, "A").End(xlUp).Offset(1, 0)
[COLOR=#ff0000]            ElseIf Target = "" Then[/COLOR]
[COLOR=#ff0000]                Rows(Target.Row).EntireRow.Copy Sheets("Open").Cells(LastRow, 1)[/COLOR]
            End If
        Case Is = 3
            If Target.Offset(, -1) = "" Then Target.Offset(, -1) = Date
        Case Is = 7
            If Target.Offset(, -1) = "" Then Target.Offset(, -1) = Date
    End Select
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

 

[Fluff]

Removing the red lines should be ok