Bob,

Here is the initial script that searches the records:

Private Sub UpdateListsButton_Click()
' Updates all Lists

MsgBox "You are about to update records. This may take a few minutes.",
vbOKOnly, "Notice"

Application.ScreenUpdating = False

' Verifies correct status
Sheet7.Visible = xlSheetVisible
Sheet2.Visible = xlSheetVisible
Sheet1.Visible = xlSheetVisible
Sheet1.Activate
Udts = 0
Rcds = Application.CountA(ActiveSheet _
.Range("X:X"))

Ind = "N"
Sts = "EXPIRED"

Set f = Columns(24).Find(What:=Ind)

If f Is Nothing Then
MsgBox "No records were found that needed updating.", vbOKOnly, "Update
Complete"
Exit Sub
End If

f.Offset(0, 0).Activate
Set PetSur = ActiveCell.Offset(0, -20)
Set PetNam = ActiveCell.Offset(0, -19)
Set RspSur = ActiveCell.Offset(0, -16)
Set RspNam = ActiveCell.Offset(0, -15)
Set IssDat = ActiveCell.Offset(0, -14)
Set ExpDat = ActiveCell.Offset(0, -13)
FF = PetSur & PetNam & RspSur & RspNam & IssDat & ExpDat

If ActiveCell.Offset(0, -21).Value = Sts Then
ActiveCell.EntireRow.Copy
Sheet2.Activate
LastPlc = Application.CountA(ActiveSheet _
.Range("D:D")) + 1 ' Finds last cell/row plus one
Cells(LastPlc, 1).PasteSpecial
Sheet7.Activate
LastPlc = Application.CountA(ActiveSheet _
.Range("A:A")) + 4 ' Finds last cell/row plus one
Cells(LastPlc, 1).Value = PetSur
Cells(LastPlc, 2).Value = PetNam
Cells(LastPlc, 3).Value = RspSur
Cells(LastPlc, 4).Value = RspNam
Cells(LastPlc, 5).Value = IssDat
Cells(LastPlc, 6).Value = ExpDat
Sheet1.Activate
Udts = Udts + 1
Rcds = Rcds - 1
End If

Set f = Columns(24).FindNext(After:=f)
f.Offset(0, 0).Activate

Do
Set PetSur = ActiveCell.Offset(0, -20)
Set PetNam = ActiveCell.Offset(0, -19)
Set RspSur = ActiveCell.Offset(0, -16)
Set RspNam = ActiveCell.Offset(0, -15)
Set IssDat = ActiveCell.Offset(0, -14)
Set ExpDat = ActiveCell.Offset(0, -13)
FND = PetSur & PetNam & RspSur & RspNam & IssDat & ExpDat
If FND = FF Then
Exit Do
End If
If ActiveCell.Offset(0, -21).Value = Sts Then
ActiveCell.EntireRow.Copy
Sheet2.Activate
LastPlc = Application.CountA(ActiveSheet _
.Range("D:D")) + 1 ' Finds last cell/row plus one
Cells(LastPlc, 1).PasteSpecial
Sheet7.Activate
LastPlc = Application.CountA(ActiveSheet _
.Range("A:A")) + 4 ' Finds last cell/row plus one
Cells(LastPlc, 1).Value = PetSur
Cells(LastPlc, 2).Value = PetNam
Cells(LastPlc, 3).Value = RspSur
Cells(LastPlc, 4).Value = RspNam
Cells(LastPlc, 5).Value = IssDat
Cells(LastPlc, 6).Value = ExpDat
Udts = Udts + 1
Sheet1.Activate
End If
Set f = Columns(24).FindNext(After:=f)
f.Offset(0, 0).Activate
Loop

Rcds = Application.CountA(ActiveSheet _
.Range("X:X"))

Ind = "N"
Sts = "TERMINATED"

Set f = Columns(24).Find(What:=Ind)
f.Offset(0, 0).Activate
Set PetSur = ActiveCell.Offset(0, -20)
Set PetNam = ActiveCell.Offset(0, -19)
Set RspSur = ActiveCell.Offset(0, -16)
Set RspNam = ActiveCell.Offset(0, -15)
Set IssDat = ActiveCell.Offset(0, -14)
Set ExpDat = ActiveCell.Offset(0, -13)
FF = PetSur & PetNam & RspSur & RspNam & IssDat & ExpDat

If ActiveCell.Offset(0, -21).Value = Sts Then
ActiveCell.EntireRow.Copy
Sheet2.Activate
LastPlc = Application.CountA(ActiveSheet _
.Range("D:D")) + 1 ' Finds last cell/row plus one
Cells(LastPlc, 1).PasteSpecial
Sheet7.Activate
LastPlc = Application.CountA(ActiveSheet _
.Range("A:A")) + 4 ' Finds last cell/row plus one
Cells(LastPlc, 1).Value = PetSur
Cells(LastPlc, 2).Value = PetNam
Cells(LastPlc, 3).Value = RspSur
Cells(LastPlc, 4).Value = RspNam
Cells(LastPlc, 5).Value = IssDat
Cells(LastPlc, 6).Value = ExpDat
Sheet1.Activate
Udts = Udts + 1
Rcds = Rcds - 1
End If

Set f = Columns(24).FindNext(After:=ActiveCell)
f.Offset(0, 0).Activate

Do
Set PetSur = ActiveCell.Offset(0, -20)
Set PetNam = ActiveCell.Offset(0, -19)
Set RspSur = ActiveCell.Offset(0, -16)
Set RspNam = ActiveCell.Offset(0, -15)
Set IssDat = ActiveCell.Offset(0, -14)
Set ExpDat = ActiveCell.Offset(0, -13)
FND = PetSur & PetNam & RspSur & RspNam & IssDat & ExpDat
If FND = FF Then
Exit Do
End If
If ActiveCell.Offset(0, -21).Value = Sts Then
ActiveCell.EntireRow.Copy
Sheet2.Activate
LastPlc = Application.CountA(ActiveSheet _
.Range("D:D")) + 1 ' Finds last cell/row plus one
Cells(LastPlc, 1).PasteSpecial
Sheet7.Activate
LastPlc = Application.CountA(ActiveSheet _
.Range("A:A")) + 4 ' Finds last cell/row plus one
Cells(LastPlc, 1).Value = PetSur
Cells(LastPlc, 2).Value = PetNam
Cells(LastPlc, 3).Value = RspSur
Cells(LastPlc, 4).Value = RspNam
Cells(LastPlc, 5).Value = IssDat
Cells(LastPlc, 6).Value = ExpDat
Udts = Udts + 1
Sheet1.Activate
End If
Set f = Columns(24).FindNext(After:=f)
f.Offset(0, 0).Activate
Loop

If Udts = 0 Then
MsgBox "All records are up-to-date. No records needed updated.", _
vbOKOnly, "No updates needed"
Exit Sub
End If

lp = 0

If Udts = 1 Then
Sheet7.Activate
ActiveSheet.PrintOut
Udts2 = Udts
Do Until Udts2 = 0
Udts2 = Udts - 1
lp = lp + 1
Cells(7, 1).Activate
ActiveCell.EntireRow.Delete
If lp = 1000 Then
Exit Do
End If
Loop
End If

Sheet7.Visible = xlSheetVeryHidden
Sheet2.Visible = xlSheetVeryHidden
Sheet1.Visible = xlSheetVeryHidden
Sheet4.Activate
Application.ScreenUpdating = True

MsgBox "All lists have been updated. " & Udts & " records have been
updated.", _
vbOKOnly, "Update Complete"

End Sub



This is the formula that returns the status of "VALID", "EXPIRED",
"TERMINATED", or "INVALID", which is the actual contents of the cells in
column "C":

=IF(D4="","INVALID",(IF(H4="","INVALID",(IF(M4="YE S","TERMINATED",(IF(K4="INDEF","VALID",(IF(ISTEXT( K4),"INVALID",(IF(K4=TODAY(),"VALID",(IF(K4="","I NVALID","EXPIRED")))))))))))))


Cell references here are as follows:

D4 - 1st Person Last name
H4 - 2nd Person Last name
M4 - Yes/No field if it has been terminated
K4 - Expiration date

Thanks for your help.