Modification of existing code

I

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
 
T

Tom Ogilvy

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
 
K

Keith74

Hi

I could well be over simplifing here but, try replacing

Rows(LoopCounter).Delete

with

Rows(LoopCounter + 1).Delete

hth

keith
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top