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

 

[kevin9999]

This worked but moved rows instead of copied rows

Do you mean that you don't want them deleted from the CRASH CART sheet?

 

[saileen]

Do you mean that you don't want them deleted from the CRASH CART sheet?

Correct, just copied.

 

[kevin9999]

I that case, we can just remove the deletion lines:

Option Explicit
Sub test_V3()
    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)
            End With
            .AutoFilter.ShowAllData
        End With
    End With
    End If
    ws1.Columns(LCol + 1).Delete
    ws2.Columns(LCol + 1).Delete
End Sub

 

[saileen]

I that case, we can just remove the deletion lines:

Option Explicit
Sub test_V3()
    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)
            End With
            .AutoFilter.ShowAllData
        End With
    End With
    End If
    ws1.Columns(LCol + 1).Delete
    ws2.Columns(LCol + 1).Delete
End Sub

I am sure this is working when you do it, so I am wondering does it matter which sheet I enter this code into? Either S1 or Crash Cart? I removed the 2 delete lines:

ws1.Columns(LCol + 1).Delete
ws2.Columns(LCol + 1).Delete

Nothing appears on the S1 tab and then on Crash Cart the rows that are <=30 days/today are available to view and the other rows are hidden.

 

[kevin9999]

I already removed the relevant lines for you in post #13. That's the code you should be using. The code goes into a standard module - not a sheet module. The code is working fine for me.

 

[saileen]

Sorry for the delay - I was sick. This is working!

Thanks for all your help

I already removed the relevant lines for you in post #13. That's the code you should be using. The code goes into a standard module - not a sheet module. The code is working fine for me.

 

[kevin9999]

You're welcome, and thanks for the feedback