Check all specified sheets for expired date in column and copy the row info to expired sheet

slayer1957

New Member
Joined
Jan 9, 2017
Messages
28
I have a few sheets, sheets 1-6 which has a date starting from column "I" and row "2". I have some code that can check a sheet in that column if the date has passed and copy the row to Expired sheet once you click a button.

I just need it to check all specified sheets 1-6 or per name of sheet and copy all data making a list of all the expired rows to the Expired sheet as a Module vba. It must copy data continuing until all rows have been copied.

VBA Code:
Sub License_Check()
Application.ScreenUpdating = False
Dim i As Long
Dim Lastrow As Long
Dim Lastrowa As Long
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Lastrowa = Sheets("Expired").Cells(Rows.Count, "A").End(xlUp).Row + 1
    For i = 3 To Lastrow
        If Cells(i, 9) < Date Then
            Rows(i).Copy Destination:=Sheets("Expired").Rows(Lastrowa)
            Lastrowa = Lastrowa + 1
        End If
    Next
Application.ScreenUpdating = True
End Sub
 

Some videos you may like

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().

My Aswer Is This

Well-known Member
Joined
Jul 5, 2014
Messages
17,473
Office Version
  1. 2013
Platform
  1. Windows
Try this:
This script looks at sheet 2 to last sheet in workbook
VBA Code:
Sub License_Check()
'Modified  12/4/2020  7:31:48 AM  EST
Application.ScreenUpdating = False
Dim i As Long
Dim Lastrow As Long
Dim Lastrowa As Long
Dim b As Long
For b = 2 To Sheets.Count

With Sheets(b)
    Lastrow = .Cells(Rows.Count, "I").End(xlUp).Row
    Lastrowa = Sheets("Expired").Cells(Rows.Count, "I").End(xlUp).Row + 1
        For i = 3 To Lastrow
            If .Cells(i, 9) < Date And .Cells(i, 9).Value <> "" Then
                .Rows(i).Copy Destination:=Sheets("Expired").Rows(Lastrowa)
                Lastrowa = Lastrowa + 1
            End If
    Next
    End With
    Next
   
Application.ScreenUpdating = True
End Sub
 
Solution

Watch MrExcel Video

Forum statistics

Threads
1,128,022
Messages
5,628,186
Members
416,299
Latest member
arunvistas

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top