Modification of existing code
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 |
Modification of existing code
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 -- Regards, Tom Ogilvy "Ixtreme" wrote: 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 |
Modification of existing code
Hi
I could well be over simplifing here but, try replacing Rows(LoopCounter).Delete with Rows(LoopCounter + 1).Delete hth keith |
Modification of existing code
Tom,
That's it! Thanks, Mark |
All times are GMT +1. The time now is 10:46 PM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com