Hi Sue,

First and foremost. Make sure you have a backup of your data before
attempting to run the macros.

I have developed some code for you but instead of the code going ahead and
deleting the rows, I have written two macros; one to mark the rows to be
deleted and the second one to actually delete the rows. My reason for this is
that you need to do a reasonable sample check after the rows are marked for
deletion to ensure that the correct rows are being deleted.

My assumptions:-

1. That your data is in columns A to I and

2. Column A (headed HRID) does not have any blank cells before the bottom of
the data. If it does then I will have to modify the macro because I use this
column to identify the end of the data.

The delete reference and notes are written to columns J and K. If you have
got anything in these columns then I suggest that you insert 2 columns after
column I and they can be deleted after completion.

You run the first macro (Mark_for_Delete) and then check the rows to be
deleted. You will see that in column K will be written the row number of a
duplicate record (If any) for records where CurrentDate is blank and TermDate
is populated. (It only finds one duplicate and if more then they are ignored).

After checking, if you are happy that the deletes are correct then run the
second macro (Delete_Rows) which will do the deletions for you.

Records with CurrentDate and NO TermDate have no comment because you did not
specify anything for them.

Feel free to get back to me if you have any problems.


Sub Mark_for_Delete()
Dim c As Range 'Cell in column H
Dim strHRID As String
Dim foundHRID As Range
Dim strFirstAddr As String
Dim datePrior As Date

'NOTE: If altering the date between # # then enter date
'using the the alpha characters for the month and let
'Excel reset to numerics.
'Example Jan 1 2007 or 1 Jan 2007 is acceptable.

datePrior = #1/1/2007#

Sheets("Sheet1").Select
For Each c In Range("H:H")
'Next line tests for blank in column A
'and assumes end of data if it is blank
If c.Offset(0, -7) = "" Then Exit For

'Test if Current and Term are blank
If c.Value = "" And c.Offset(0, 1).Value = "" Then
c.Offset(0, 2).Value = "Ignore"
GoTo skipToNextc
End If

'Test if Current blank and Term populated
If c.Value = "" And c.Offset(0, 1).Value 0 Then
'Save value and address of HRID
strHRID = c.Offset(0, -7).Value
strFirstAddr = c.Offset(0, -7).Address

'Find strHRID
Set foundHRID = Columns("A:A") _
.Find(What:=strHRID, _
After:=c.Offset(0, -7), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)

'Not necessary to test if found because
'must find at least one at the current c.row.

Do
'Test if not found at current row
If foundHRID.Address < strFirstAddr Then
'Found but not at current c.row
'Test if Current and Term are blank at new location
If foundHRID.Offset(0, 7) = "" And foundHRID.Offset(0, 8) =
"" Then
'Both blank so write Delete to column J.
c.Offset(0, 2).Value = "Delete"
c.Offset(0, 2).Interior.ColorIndex = 3
'Write duplicate row number to column K
c.Offset(0, 3).Value = "Duplicate Row " & foundHRID.Row
Exit Do 'No additional find require
Else
'Not both blank so look for another record
Set foundHRID = Columns("A:A").FindNext(foundHRID)
End If
Else
'Only one record Current blank and Term populated
c.Offset(0, 2).Value = "No Match with Current & Term blank"
Exit Do
End If
Loop While Not foundHRID Is Nothing And foundHRID.Address <
firstAddress
End If

'Test if current and term are populated
If c.Value 0 And c.Offset(0, 1).Value 0 Then
'test if current and term less than datePrior
If c.Value < datePrior And c.Offset(0, 1).Value < datePrior Then
c.Offset(0, 2).Value = "Delete"
c.Offset(0, 2).Interior.ColorIndex = 3
Else
c.Offset(0, 2).Value = "Recent"
End If
End If
skipToNextc:
Next c

End Sub

Sub Delete_Rows()

Dim c As Range 'Cell in column H

Sheets("Sheet1").Select
For Each c In Range("J:J")
'Next line tests for blank in column A
'and assumes end of data if it is blank
If c.Offset(0, -7) = "" Then Exit For

If c.Value = "Delete" Then
c.EntireRow.Delete
End If
Next c

End Sub


Regards,

OssieMac