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
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