Copying a row to another tab when condition is met on expiry date

[saileen]

Hi
I am trying to copy rows in multiple tabs that once they reach < = 30 days of expiry date into a new tab. There are up to 4 expiration dates per row/sheet (rows J, L, N, P). Am I able to move onto the new sheet with those conditions, and do I need to create an additional column to reference which tab the row is being copied from to help identify from? Also if the expiry date is updated on the original tab will this automatically remove the copied row since it won't meet the condition?

All the sheets have the same column names and the sheet I would be copying them to is called S1

 

[saileen]

I tried to do the macro recorder but really unsure on how to use the code to trigger the expired/and within 30 day products to transfer to S1.

Sub Macro2()
'
' Macro2 Macro
'

'
Sheets("CRASH CART").Select
Rows("50:50").Select
Range("C50").Activate
Selection.Copy
Sheets("S1").Select
Range("A3").Select
ActiveSheet.Paste
Range("D9").Select
End Sub

 

[kevin9999]

Could you provide your sheet using the XL2BB add in, as it's impossible to tell from your image whether there's anything in column A, or what row your data starts on. Alternatively, share your file via Google Drive, Dropbox or similar file sharing platform.

Are you saying that you want to copy - then delete - any records from "multiple tabs" and paste them in another tab if the expiry date is <= 30 days from today in any of columns J, L, N or P? From what source tabs? To what tab? Also, what exactly do you mean by this:

Also if the expiry date is updated on the original tab will this automatically remove the copied row since it won't meet the condition?

Do you mean if the expiry date in any of the 4 columns is updated to not <= 30 days then don't copy it?

 

[saileen]

Hi,
here is the excel workbook

My main concern is the crash cart tab and having any products within <= 30 days copy to S1 tab.

Also if the expiry date is updated on the original tab will this automatically remove the copied row since it won't meet the condition?

Do you mean if the expiry date in any of the 4 columns is updated to not <= 30 days then don't copy it?

If the expiry date in column J has past and it has already been flagged for re-order the next stock batch would be loaded into column L and would not need to be copied into the S1 tab.. unless there is a way to only copy which expiration date column is within the condition on S1 and only pulling Stock #, Description, Missing/Expiration date?

The other sheets are a hot mess that I haven't had a chance to tidy up yet. So I might be asking too much for all the tabs to filter into S1 when they need to be re-ordered, so please ignore that request.

 

[kevin9999]

If the expiry date in column J has past and it has already been flagged for re-order the next stock batch would be loaded into column L and would not need to be copied into the S1 tab.. unless there is a way to only copy which expiration date column is within the condition on S1 and only pulling Stock #, Description, Missing/Expiration date?

I've read this a number of times, and still have no idea what your flow of logic is.
There is no "S1" tab on the file you shared.
Some of the 'dates' in both columns J & L on the "CRASH CART" tab are actually text entries, not real dates, which would therefore interfere with any filtering etc. that could be applied via VBA code.
How does the "flagged for re-order" happen, and how is it shown on the sheet?
What is the "condition on S1", and "only pulling Stock # etc. " even mean?
I think you need to clean up your sheet first, then explain in clear logic what must happen, according to what condition, in plain English.

 

[saileen]

I didn't realize I uploaded the wrong file, sorry. Excel file

How does the "flagged for re-order" happen, and how is it shown on the sheet?

Crash Cart Sheet- Right now the expiration date columns turn orange or red if the stock is about to expire and will need to be re-ordered. I want all the products that are expiring within <= 30 days or have expired to copy to tab S1.

I think you need to clean up your sheet first, then explain in clear logic what must happen, according to what condition, in plain English.

If Expiration 1, 2, 3, 4 is <= 30 days from today or is today then copy row to S1 starting at A3

 

[kevin9999]

I've a feeling this will take a bit of back and forth to get right, but please try the following on a copy of your workbook.

Option Explicit
Sub test()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Worksheets("CRASH CART")
    Set ws2 = Worksheets("S1")
    
    Dim rng As Range, LRow As Long, LCol As Long
    LRow = ws1.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
    LCol = ws1.Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column
    Set rng = ws1.Range(ws1.Cells(8, 1), ws1.Cells(LRow, LCol + 1))
    
    Dim a, b
    a = ws1.Range(ws1.Cells(9, 10), ws1.Cells(LRow, 16))
    ReDim b(1 To UBound(a, 1), 1 To 1)
    Dim i As Long, j As Long
    For i = 1 To UBound(a, 1)
        For j = 1 To 7 Step 2
            If IsDate(a(i, j)) And a(i, j) <= Date + 30 Then b(i, 1) = 1
        Next j
    Next i
    ws1.Cells(9, LCol + 1).Resize(UBound(b, 1)).Value = b
    
    With rng
        .AutoFilter LCol + 1, 1
        .Offset(1).Resize(, 17).Copy ws2.Cells(Rows.Count, 1).End(xlUp).Offset(1)
        .Offset(1).EntireRow.Delete
    End With
    ws1.Columns(LCol + 1).Delete
End Sub

 

[saileen]

I've a feeling this will take a bit of back and forth to get right, but please try the following on a copy of your workbook.

Option Explicit
Sub test()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Worksheets("CRASH CART")
    Set ws2 = Worksheets("S1")
   
    Dim rng As Range, LRow As Long, LCol As Long
    LRow = ws1.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
    LCol = ws1.Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column
    Set rng = ws1.Range(ws1.Cells(8, 1), ws1.Cells(LRow, LCol + 1))
   
    Dim a, b
    a = ws1.Range(ws1.Cells(9, 10), ws1.Cells(LRow, 16))
    ReDim b(1 To UBound(a, 1), 1 To 1)
    Dim i As Long, j As Long
    For i = 1 To UBound(a, 1)
        For j = 1 To 7 Step 2
            If IsDate(a(i, j)) And a(i, j) <= Date + 30 Then b(i, 1) = 1
        Next j
    Next i
    ws1.Cells(9, LCol + 1).Resize(UBound(b, 1)).Value = b
   
    With rng
        .AutoFilter LCol + 1, 1
        .Offset(1).Resize(, 17).Copy ws2.Cells(Rows.Count, 1).End(xlUp).Offset(1)
        .Offset(1).EntireRow.Delete
    End With
    ws1.Columns(LCol + 1).Delete
End Sub

Hi,
So this did pull all of the products over to S1 that have an expiration date <=30 days and/or today but all of the data that was in the crash cart sheet is now gone. Only the table headers remain.

 

[kevin9999]

That didn't happen when I tested the code on your sample file, however, give this version a try on a copy of your workbook:

Option Explicit
Sub test_V2()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Worksheets("CRASH CART")
    Set ws2 = Worksheets("S1")
    
    Dim LRow As Long, LCol As Long
    LRow = ws1.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
    LCol = ws1.Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column
    
    Dim a, b
    a = ws1.Range(ws1.Cells(9, 10), ws1.Cells(LRow, 16))
    ReDim b(1 To UBound(a, 1), 1 To 1)
    
    Dim i As Long, j As Long
    For i = 1 To UBound(a, 1)
        For j = 1 To 7 Step 2
            If IsDate(a(i, j)) And a(i, j) <= Date + 30 Then b(i, 1) = 1
        Next j
    Next i
    ws1.Cells(9, LCol + 1).Resize(UBound(b, 1)).Value = b
    If WorksheetFunction.Sum(ws1.Columns(LCol + 1)) > 0 Then
    With ws1
        .ListObjects(1).AutoFilter.ShowAllData
        With .ListObjects(1)
            .AutoFilter.ShowAllData
            .Range.AutoFilter LCol + 1, 1
            With .DataBodyRange.SpecialCells(xlCellTypeVisible)
                .Copy ws2.Cells(Rows.Count, 1).End(xlUp).Offset(1)
                Application.DisplayAlerts = False
                .Rows.Delete
                Application.DisplayAlerts = True
            End With
            
            .AutoFilter.ShowAllData
        End With
    End With
    End If
    ws1.Columns(LCol + 1).Delete
    ws2.Columns(LCol + 1).Delete
End Sub

 

[saileen]

That didn't happen when I tested the code on your sample file, however, give this version a try on a copy of your workbook:

Option Explicit
Sub test_V2()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Worksheets("CRASH CART")
    Set ws2 = Worksheets("S1")
   
    Dim LRow As Long, LCol As Long
    LRow = ws1.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
    LCol = ws1.Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column
   
    Dim a, b
    a = ws1.Range(ws1.Cells(9, 10), ws1.Cells(LRow, 16))
    ReDim b(1 To UBound(a, 1), 1 To 1)
   
    Dim i As Long, j As Long
    For i = 1 To UBound(a, 1)
        For j = 1 To 7 Step 2
            If IsDate(a(i, j)) And a(i, j) <= Date + 30 Then b(i, 1) = 1
        Next j
    Next i
    ws1.Cells(9, LCol + 1).Resize(UBound(b, 1)).Value = b
    If WorksheetFunction.Sum(ws1.Columns(LCol + 1)) > 0 Then
    With ws1
        .ListObjects(1).AutoFilter.ShowAllData
        With .ListObjects(1)
            .AutoFilter.ShowAllData
            .Range.AutoFilter LCol + 1, 1
            With .DataBodyRange.SpecialCells(xlCellTypeVisible)
                .Copy ws2.Cells(Rows.Count, 1).End(xlUp).Offset(1)
                Application.DisplayAlerts = False
                .Rows.Delete
                Application.DisplayAlerts = True
            End With
           
            .AutoFilter.ShowAllData
        End With
    End With
    End If
    ws1.Columns(LCol + 1).Delete
    ws2.Columns(LCol + 1).Delete
End Sub

This worked but moved rows instead of copied rows