Add date function to this code

Hello Sean,

Firstly, I must apologise. The code I gave you in post #1 is a Worksheet_Change event code not a Workbook_SheetChange event  code (**slaps palm into forehead**). Perhaps I should give up dancing in the rain! :-)

So, I've modified your original code with the addition of the add date line as follows:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

        Dim ws As Worksheet: Set ws = Sheets("Historical")

        If Intersect(Target, Sh.Columns("H:H")) Is Nothing Then Exit Sub
        If Target.Count > 1 Then Exit Sub
        If Target.Value = vbNullString Then Exit Sub
        If Sh.Name = "Historical" Then Exit Sub

Application.ScreenUpdating = False
Application.EnableEvents = False

        If Target.Value = "Closed" Then
             Target.Offset(, 2) = Date
             Target.EntireRow.Copy ws.Range("A" & Rows.Count).End(3)(2)
             Target.EntireRow.Delete
        End If

        ws.Columns.AutoFit

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

The offset is two columns to the right(J) and should work for you now. I wasn't able to open the link so, again, I haven't actually tested it. Let me know how it works out.

Create a copy of your workbook to test this code within it. Make sure it goes into the ThisWorkbook module and make sure to remove the old code and replace it with this updated one.

I hope that this helps.

Cheerio,

vcoolio.

Hello Sean,

See if the code, modified a little as follows, will do the task for you. Please note that I've not tested it.
 

Option Compare Text
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim ws As Worksheet: Set ws = Sheets("Historical")
    
    If Intersect(Target, Columns(8)) Is Nothing Then Exit Sub
    If Target.Cells.Count > 1 Then Exit Sub
    
    Application.ScreenUpdating = False
    
        If Target.Value = "Closed" Then
              Target.Offset(, 2) = Date
              Target.EntireRow.Copy ws.Range("A" & Rows.Count).End(3)(2)
              Target.EntireRow.Delete
              ws.Columns.AutoFit
        End If
        
    Application.ScreenUpdating = True

End Sub

For the date in Column J of each row of the "Historical" sheet, I've used "Date" instead of the "Today()" function. This is because the Today() function is volatile which means that each consecutive day, the date will change to the current date hence showing an incorrect closure day. Using "Date" will ensure that the date remains static and will be a permanent record in the "Historical" sheet.

I hope that this helps.

Cheerio,

vcoolio.

Thanks HelpiOS.

It may only be a fleeting look-in as life has been very hectic on my end for quite a while now.

Cheerio,

vcoolio.

You're welcome Sean. I'm glad its all sorted and working as you'd like.

I'm happy to have been able to assist.

Cheerio,

vcoolio.