how to create a worksheet OPEN event to scan a sheet based on dates (expired)

this is a continuation of this POST:

so what i am looking for is the following:

Use the worksheet open event to scan the sheet "Closed POs" and look for expired dates (anything more than a month) in column D.

i already have the code for the change event and that works. what is needed now is the above.

can anyone help me out with this?

@xlnitwit,

your sub is named ProcessDates but the following two macros used ProcessCells. should i change ProcessCells to ProcessDates?

so i got the stub to work, thanks for that.

now i have to create the macro that moves the data from the workbook "Status of POs" on the "Closed POs" sheet to the "ClosedPOsOverAMonth" workbook on the "ClosedPOs" sheet. in fact there will only be one sheet in this workbook so best to refer to this as Sheets(1) i think.

the first thing is to see if the "ClosedPOsOverAMonth.xlsm" is Open, if it's not then open it (my code dies at this part), note that i removed the if statement to get the worksheet to open but it still fails.

then when the date changes in col D on the "Closed POs" sheet, it moves the row (A:D) to the next available row in "ClosedPOsOverAMonth". there is only one table on this sheet.

so here is the code that is failing:

Sub processCells(ByVal Target As Range)
Dim ws As Worksheet
Dim wb As Workbook
Dim wbws As String
Dim my_Filename As Variant

Set wb = Workbooks.Open("Z:\OPERATIONS\Purchase Orders\Dan\ClosedPOsOverAMonth.xlsm")
'if wb = False then Workbooks.Open("Z:\OPERATIONS\Purchase Orders\Dan\ClosedPOsOverAMonth.xlsm")
Set ws = wb.Sheets("ClosedPOs")

Dim cell As Range

    For Each cell In Target.Cells
        Select Case cell.Value
            Case Is < Now - 30
                'MsgBox "Move to Closed PO archive file"
                'Range("A" & Target.Row & ":D" & Target.Row).Copy
                Set ws = Sheets("ClosedPOs")
                ''Dim tbl As ListObject
                Set tbl = ws.ListObjects(1)
                Dim newrow As ListRow
                Set newrow = tbl.ListRows.Add

                With newrow
                    .Range(1).Value = Range("A" & Target.Row)
                    .Range(1).Font.StrikeThrough = True
                    .Range(2).Value = Range("B" & Target.Row)
                    .Range(2).Font.StrikeThrough = True
                    .Range(3).Value = Range("C" & Target.Row)
                    .Range(3).Font.StrikeThrough = True
                    .Range(4).Value = Range("D" & Target.Row)
                    .Range(4).Font.StrikeThrough = True

                    
                End With
                'Set ws = Sheets("Outstanding POs")
                'Set tbl = ws.ListObjects(1)
                'delete a row at the end of the table
                'tbl.ListRows(Target.Row - 1).Delete
                'move line to "ClosedPOs" table
                Target.ClearContents
                
                'Target.Value = "Move to closed po file"
            Case Is >= Now - 30
                'MsgBox "Keep for now"
                Exit Sub
            Case Else
                MsgBox "Case Else"
        End Select
    Next cell
End Sub

im stuck on the wb and ws statements. it errors on the set tbl=ws.listobjects(1) line.

any ideas on how to fix this error?

so i had to start over from the stub. i got this working (sortof), my question is how to move the target.row and add that to the table on ClosedPOs sheet?

            Case Is < Now - 30
                Windows("Status of PO's.xlsm").Activate
                Range("A" & Target.Row & ":D" & Target.Row).Select
                Selection.Copy
                Windows("ClosedPOsOverAMonth.xlsm").Activate
                Range("Table1[Closed PO''s]").Select
                ActiveSheet.Paste
                'MsgBox "Archive"

this is what i have so far but its not copying the range, can someone take a look and see what the issue is?

see the with newrow section for what is not working.

With Workbooks("ClosedPOsOverAMonth.xlsm").Sheets("ClosedPOs")

    For Each cell In Target.Cells
        Select Case cell.Value
            Case Is < Now - 30
                'ws = Sheets("ClosedPOs")
                Windows("Status of PO's.xlsm").Activate
                Range("A" & Target.Row & ":D" & Target.Row).Copy
                MsgBox Range("A" & Target.Row).Value
                Set tbl = .ListObjects(1)
                Dim newrow As ListRow
                Set newrow = tbl.ListRows.Add
                Windows("ClosedPOsOverAMonth.xlsm").Activate
                'Range("Table1[Closed PO''s]").Select
                With newrow
                    .Range(1).Value = Range("A" & Target.Row).Value
                    'the messagebox below does not display anything, what am i doing wrong?
                    MsgBox Range("A" & Target.Row).Value
                    .Range(2).Value = Range("B" & Target.Row).Value
                    .Range(3).Value = Range("C" & Target.Row).Value
                    .Range(4).Value = Range("D" & Target.Row).Value
                End With
                'ActiveSheet.Paste
                'MsgBox "Archive"
            Case Is >= Now - 30
                'do nothing
                MsgBox "Keep for now"
                Exit Sub
            Case Else
                MsgBox "Case Else"
        End Select
    Next cell
End With

so i got this to work, like so:

Sub processCells(ByVal Target As Range)
Dim ws As Worksheet
Dim wb As Workbook
Dim wbws As String
Dim my_Filename As Variant
Dim cell As Range
Dim newrow As ListRow

If CheckFileIsOpen("Z:\OPERATIONS\Purchase Orders\Dan\ClosedPOsOverAMonth.xlsm") = False Then
Workbooks.Open "Z:\OPERATIONS\Purchase Orders\Dan\ClosedPOsOverAMonth.xlsm"
End If

With Workbooks("ClosedPOsOverAMonth.xlsm").Sheets("ClosedPOs")

    For Each cell In Target.Cells
        Select Case cell.Value
            Case Is < Now - 30
                Windows("Status of PO's.xlsm").Activate
                Set tbl = Workbooks("ClosedPOsOverAMonth.xlsm").Sheets("ClosedPOs").ListObjects(1)
                
                Set newrow = tbl.ListRows.Add
                MsgBox Workbooks("Status of PO's.xlsm").Sheets("Closed POs").Range("A" & Target.Row).Value
                With newrow
                    .Range(1).Value = Workbooks("Status of PO's.xlsm").Sheets("Closed POs").Range("A" & Target.Row).Value
                    .Range(2).Value = Workbooks("Status of PO's.xlsm").Sheets("Closed POs").Range("B" & Target.Row).Value
                    .Range(3).Value = Workbooks("Status of PO's.xlsm").Sheets("Closed POs").Range("C" & Target.Row).Value
                    .Range(4).Value = Workbooks("Status of PO's.xlsm").Sheets("Closed POs").Range("D" & Target.Row).Value
                End With
                With Workbooks("Status of PO's.xlsm").Sheets("Closed POs")
                    Target.Delete
                End With
            Case Is >= Now - 30
                'do nothing
                Exit Sub
            Case Else
                MsgBox "Case Else"
        End Select
    Next cell
End With
End Sub

thanks xlnitwit for pointing me in the right direction.