Modification of existing code

[Ixtreme]

Hi,

Can somebody help me with this code? What I need is the code to work
if the match is on the row below the first one. So I have the
following data:

Column D Column E ColumnF
Date Employee OrderNr

row 67 29-08-2007 Mark 12345
row 68 29-08-2007 Mark

I want row 68 to be deleted. The code I have works if the ordernummer
is in row 68 (it will delete row 67 in that case). I have no idea how
to change the code.

The original code is:

Sub Remove_Duplicates()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

LastRow = Cells(Rows.Count, "F").End(xlUp).Row

Remove = False

Call Today

LoopCounter = ActiveCell.Row

Do While LoopCounter <= LastRow
If IsEmpty(Cells(LoopCounter, "F")) Then

MyDate = Cells(LoopCounter, "D").Value
Employee = Cells(LoopCounter, "E").Value

'For RowCount = LoopCounter To LastRow
For RowCount = LastRow To LoopCounter
If RowCount <> LoopCounter Then

If (Cells(RowCount, "D").Value = MyDate) And _
(Cells(RowCount, "E").Value = Employee) Then

Remove = True
Exit For
End If

End If

Next RowCount

End If

If Remove = True Then
Rows(LoopCounter).Delete
Remove = False
Else
LoopCounter = LoopCounter + 1
End If
Loop

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

 

[Guest]

Sub Remove_Duplicates()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

' change made
LastRow = Cells(Rows.Count, "D").End(xlUp).Row

Remove = False

Call Today

LoopCounter = ActiveCell.Row
' line added
LoopStart = ActiveCell.Row

Do While LoopCounter <= LastRow
If IsEmpty(Cells(LoopCounter, "F")) Then

MyDate = Cells(LoopCounter, "D").Value
Employee = Cells(LoopCounter, "E").Value

'For RowCount = LoopCounter To LastRow
' change made
For RowCount = LastRow To LoopStart step -1
If RowCount <> LoopCounter Then

If (Cells(RowCount, "D").Value = MyDate) And _
(Cells(RowCount, "E").Value = Employee) Then

Remove = True
Exit For
End If

End If

Next RowCount

End If

If Remove = True Then
Rows(LoopCounter).Delete
Remove = False
Else
LoopCounter = LoopCounter + 1
End If
Loop

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

 

[Keith74]

Hi

I could well be over simplifing here but, try replacing

Rows(LoopCounter).Delete

with

Rows(LoopCounter + 1).Delete

hth

keith

 

[Ixtreme]

Tom,

That's it!

Thanks,

Mark