Add date function to this code

Solved
Eagleeyes011 Posts 27 Registration date Tuesday February 8, 2022 Status Member Last seen May 28, 2024 - May 17, 2024 at 01:17 PM
vcoolio Posts 1410 Registration date Thursday July 24, 2014 Status Moderator Last seen May 23, 2024 - May 21, 2024 at 05:49 PM

Hello all,

I am looking to add a date function to cell J (or whatever column/cell I need it to be) after this code performs its actions. 

Currently this code works to take the row from one worksheet to a "historical" worksheet in the same workbook after the "closed, clOSed, Closed" is entered. I would like for there to be the current date (today) placed into cell J on that row after its moved (could be before its moved or after, whichever is easiest). This will show the date "Closed" of that one item, being the date that it was entered into the Historical worksheet. 

Y'all are awesome and have been a great help before. I humbly look forward to your help again. See below code that I'm using in the workbook currently. 

Option Compare Text

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.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


Macintosh / Chrome 124.0.0.0

Related:

4 responses

vcoolio Posts 1410 Registration date Thursday July 24, 2014 Status Moderator Last seen May 23, 2024 262
May 20, 2024 at 08:08 PM

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.

2
Eagleeyes011 Posts 27 Registration date Tuesday February 8, 2022 Status Member Last seen May 28, 2024 1
May 21, 2024 at 08:55 AM

vcoolio, 

-This worked!

-A lot of my frustrations above came from inserting the code, then having to restart my computer. The iOS device had no issues and would just run the code, but the windows machine required a restart in order to run the code without any hiccups. 

-Thank you so much, again, for your help!

0
vcoolio Posts 1410 Registration date Thursday July 24, 2014 Status Moderator Last seen May 23, 2024 262
May 19, 2024 at 07:22 AM

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.

1
HelpiOS Posts 14354 Registration date Friday October 30, 2015 Status Moderator Last seen June 4, 2024 1,879
May 19, 2024 at 04:41 PM

Nice to see that you're back vcoolio!

0
vcoolio Posts 1410 Registration date Thursday July 24, 2014 Status Moderator Last seen May 23, 2024 262
May 20, 2024 at 07:22 AM

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.

0
Eagleeyes011 Posts 27 Registration date Tuesday February 8, 2022 Status Member Last seen May 28, 2024 1
May 20, 2024 at 09:24 AM

vcoolio, Sounds like life is getting fast paced. I appreciate your input here and the time you took to look into this. While the code I posted is not exactly what you gave me before (I only changed targets on the code), your help was tremendous before. 

I've tried the code you posted here and it did not move the row or add the date. I received an email from ccm and Bobot AI, I used that code (posted below). It did move the row, but the date function did not work (I tried to change the offset for the date also and it did not work). I'm going to try and post the workbook also. But It does not look like I can post it here. So I will try another comment to see how I can upload. 

Option Compare Text

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.EntireRow.Copy ws.Range("A" & Rows.Count).End(3)(2)
Target.Offset(0, -3).Value = Date ' Write date to row before deleting
Target.EntireRow.Delete
End If

ws.Columns.AutoFit
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

0
Eagleeyes011 Posts 27 Registration date Tuesday February 8, 2022 Status Member Last seen May 28, 2024 1
May 20, 2024 at 10:01 AM

Maybe this link will work. Let me know if you have troubles opening it. 

Non-Compliance list

0
Eagleeyes011 Posts 27 Registration date Tuesday February 8, 2022 Status Member Last seen May 28, 2024 1 > Eagleeyes011 Posts 27 Registration date Tuesday February 8, 2022 Status Member Last seen May 28, 2024
Updated on May 20, 2024 at 10:05 AM

-It looks like its still stripping my links. Hopefully you can copy and paste the link below.

*edit to add... -Look at "shop 3" worksheet and you will see where I used the code you listed and it did not move, then look at the "historical" worksheet and you'll see where the Bobot AI did move the row, but did not add the date.

https://drive.google.com/file/d/15GFtFW1OmPx7VI5iHpwwc7q_dzhiVIAW/view?usp=drive_link

0
Eagleeyes011 Posts 27 Registration date Tuesday February 8, 2022 Status Member Last seen May 28, 2024 1
May 20, 2024 at 10:19 AM

I've got a fix, and seems to work. I used the old code and only replaced the bottom portion (if target.value = "closed" then... etc...) with the new code. Everything above (Application.EnableEvents = False) on the old code, I left alone. 

As always, you have helped tremendously. I don't hope that life slows down for you, I just hope that you are a quick learner and can dance in the rain sooner! Seriously though... good luck on your endeavors, and thank you very much!

1
Eagleeyes011 Posts 27 Registration date Tuesday February 8, 2022 Status Member Last seen May 28, 2024 1
May 20, 2024 at 10:35 AM

vcoolio... I know your tired of my responses already. The code did work like I mentioned. However! It only works ONE time.

-If I try to close another item, it does not run the function.

-If I close the workbook then open it and then close another line item, it will move one line and then the function stops working again.

-I'm updating the linked worksheet now. So if you happen to be on, give me a few minutes to update that one and you'll maybe see what I'm referring to. 

0
vcoolio Posts 1410 Registration date Thursday July 24, 2014 Status Moderator Last seen May 23, 2024 262
May 21, 2024 at 05:49 PM

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.

0