| Home |
| Search |
| Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Duplicate removal macro keeps newest record
Hi
I am using the following code to remove duplicate numbers in a column (deleting the whole row of data), but I am having a problem that the record being kept is the most recent by date. I would like to keep the record by date when it was first identified ie the record from January 1st rather than Jan 5th. the following is the code I am using, I apologise in advance if the answer is staring me in the face my knowledge of VBA is pretty basic and this is is code supplied here by another poster to this group (cant remember the persons name so I apologise for not referencing you). Columns("A:A").Select Dim R As Long Dim N As Long Dim V As Variant Dim Rng As Range On Error GoTo EndMacro Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Set Rng = Application.Intersect(ActiveSheet.UsedRange, _ ActiveSheet.Columns(ActiveCell.Column)) Application.StatusBar = "Processing Row: " & Format(Rng.Row, "#,##0") N = 0 For R = Rng.Rows.Count To 2 Step -1 If R Mod 500 = 0 Then Application.StatusBar = "Processing Row: " & Format(R, "#,##0") End If V = Rng.Cells(R, 1).Value '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' ' Note that COUNTIF works oddly with a Variant that is equal to vbNullString. ' Rather than pass in the variant, you need to pass in vbNullString explicitly. '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' If V = vbNullString Then If Application.WorksheetFunction.CountIf(Rng.Columns( 1), vbNullString) 1 Then Rng.Rows(R).EntireRow.Delete N = N + 1 End If Else If Application.WorksheetFunction.CountIf(Rng.Columns( 1), V) 1 Then Rng.Rows(R).EntireRow.Delete N = N + 1 End If End If Next R EndMacro: Application.StatusBar = False Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Thanks very much for any help Eddie |
|
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Duplicate removal macro keeps newest record
I changed you loop to step positive rather than negative. this should solve
the problem. Moving foorward when you delete cells you only need to increment your row counter when you don't delete a row. Deleting a row will automatically move to the next row. You have to change your loop from a FOR to DO WHILE. N = 0 R = 2 Do While R <= rng.Rows.Count If R Mod 500 = 0 Then Application.StatusBar = "Processing Row: " & Format(R, "#,##0") End If V = rng.Cells(R, 1).Value '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' ' Note that COUNTIF works oddly with a Variant that is equal to vbNullString. ' Rather than pass in the variant, you need to pass in vbNullString explicitly. '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' If V = vbNullString Then If Application.WorksheetFunction. _ CountIf(rng.Columns(1), vbNullString) 1 Then rng.Rows(R).EntireRow.Delete N = N + 1 End If Else If Application.WorksheetFunction. _ CountIf(rng.Columns(1), V) 1 Then rng.Rows(R).EntireRow.Delete N = N + 1 elsse R = R + 1 End If End If Loop End Sub "mikerobe" wrote: Hi I am using the following code to remove duplicate numbers in a column (deleting the whole row of data), but I am having a problem that the record being kept is the most recent by date. I would like to keep the record by date when it was first identified ie the record from January 1st rather than Jan 5th. the following is the code I am using, I apologise in advance if the answer is staring me in the face my knowledge of VBA is pretty basic and this is is code supplied here by another poster to this group (cant remember the persons name so I apologise for not referencing you). Columns("A:A").Select Dim R As Long Dim N As Long Dim V As Variant Dim Rng As Range On Error GoTo EndMacro Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Set Rng = Application.Intersect(ActiveSheet.UsedRange, _ ActiveSheet.Columns(ActiveCell.Column)) Application.StatusBar = "Processing Row: " & Format(Rng.Row, "#,##0") N = 0 For R = Rng.Rows.Count To 2 Step -1 If R Mod 500 = 0 Then Application.StatusBar = "Processing Row: " & Format(R, "#,##0") End If V = Rng.Cells(R, 1).Value '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' ' Note that COUNTIF works oddly with a Variant that is equal to vbNullString. ' Rather than pass in the variant, you need to pass in vbNullString explicitly. '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' If V = vbNullString Then If Application.WorksheetFunction.CountIf(Rng.Columns( 1), vbNullString) 1 Then Rng.Rows(R).EntireRow.Delete N = N + 1 End If Else If Application.WorksheetFunction.CountIf(Rng.Columns( 1), V) 1 Then Rng.Rows(R).EntireRow.Delete N = N + 1 End If End If Next R EndMacro: Application.StatusBar = False Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Thanks very much for any help Eddie |
|
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Duplicate removal macro keeps newest record
On May 22, 4:31 pm, Joel wrote:
I changed you loop to step positive rather than negative. this should solve the problem. Moving foorward when you delete cells you only need to increment your row counter when you don't delete a row. Deleting a row will automatically move to the next row. You have to change your loop from a FOR to DO WHILE. N = 0 R = 2 Do While R <= rng.Rows.Count If R Mod 500 = 0 Then Application.StatusBar = "Processing Row: " & Format(R, "#,##0") End If V = rng.Cells(R, 1).Value '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' ' Note that COUNTIF works oddly with a Variant that is equal to vbNullString. ' Rather than pass in the variant, you need to pass in vbNullString explicitly. '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' If V = vbNullString Then If Application.WorksheetFunction. _ CountIf(rng.Columns(1), vbNullString) 1 Then rng.Rows(R).EntireRow.Delete N = N + 1 End If Else If Application.WorksheetFunction. _ CountIf(rng.Columns(1), V) 1 Then rng.Rows(R).EntireRow.Delete N = N + 1 elsse R = R + 1 End If End If Loop End Sub "mikerobe" wrote: Hi I am using the following code to remove duplicate numbers in a column (deleting the whole row of data), but I am having a problem that the record being kept is the most recent by date. I would like to keep the record by date when it was first identified ie the record from January 1st rather than Jan 5th. the following is the code I am using, I apologise in advance if the answer is staring me in the face my knowledge of VBA is pretty basic and this is is code supplied here by another poster to this group (cant remember the persons name so I apologise for not referencing you). Columns("A:A").Select Dim R As Long Dim N As Long Dim V As Variant Dim Rng As Range On Error GoTo EndMacro Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Set Rng = Application.Intersect(ActiveSheet.UsedRange, _ ActiveSheet.Columns(ActiveCell.Column)) Application.StatusBar = "Processing Row: " & Format(Rng.Row, "#,##0") N = 0 For R = Rng.Rows.Count To 2 Step -1 If R Mod 500 = 0 Then Application.StatusBar = "Processing Row: " & Format(R, "#,##0") End If V = Rng.Cells(R, 1).Value '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' ' Note that COUNTIF works oddly with a Variant that is equal to vbNullString. ' Rather than pass in the variant, you need to pass in vbNullString explicitly. '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' If V = vbNullString Then If Application.WorksheetFunction.CountIf(Rng.Columns( 1), vbNullString) 1 Then Rng.Rows(R).EntireRow.Delete N = N + 1 End If Else If Application.WorksheetFunction.CountIf(Rng.Columns( 1), V) 1 Then Rng.Rows(R).EntireRow.Delete N = N + 1 End If End If Next R EndMacro: Application.StatusBar = False Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Thanks very much for any help Eddie Thanks Joel Just cant seem to get this to work as it deletes too many rows (deletes rows I need to keep). The following is an example of the data in the columns (a to f being actual column headings) A B C D E F G 10113 test any X somedata somedtatz 10/08/07 10113 test any X somedata somedtatz 17/08/07 10113 test any X somedata somedtatz 19/08/07 13283 tester all Q somedtatx somedatab 09/06/07 13283 tester all Q somedtatx somedatab 13/06/07 13283 tester all Q somedtatx somedatab 29/06/07 13283 tester all Q somedtatx somedatab 17/06/07 13283 tester all Q somedtatx somedatab 25/06/07 13283 tester all Q somedtatx somedatab 10/06/07 20458 tested some F somedtatq somedataw 20/04/07 20458 tested some F somedtatq somedataw 29/04/07 20458 tested some F somedtatq somedataw 05/04/07 Hoping to be left with A B C D E F G 10113 test any X somedata somedtatz 10/08/07 13283 tester all Q somedtatx somedatab 09/06/07 20458 tested some F somedtatq somedataw 05/04/07 Hope this is clear Thanks Eddie |
|
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Duplicate removal macro keeps newest record
Let me explain N and R
R - is the current row. It only need to get incrementerd when you don't delete a row N - Is your loop counter. It must be incremented everytime you go through the loop so you know when you get to the last row. Sub test() Set rng = ActiveSheet R = 1 N = 1 With rng LastRow = .Range("A" & Rows.Count).End(xlUp).Row Do While N <= LastRow If R Mod 500 = 0 Then Application.StatusBar = "Processing Row: " & Format(R, "#,##0") End If V = .Cells(R, "A").Value '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' ' Note that COUNTIF works oddly with a Variant that is equal to 'vbNullString. ' Rather than pass in the variant, you need to pass in vbNullString 'explicitly. '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' If V = vbNullString Then If Application.WorksheetFunction. _ CountIf(.Columns(1), vbNullString) 1 Then .Rows(R).Delete End If Else If Application.WorksheetFunction. _ CountIf(.Columns(1), V) 1 Then .Rows(R).Delete Else R = R + 1 End If End If N = N + 1 Loop End With End Sub "mikerobe" wrote: On May 22, 4:31 pm, Joel wrote: I changed you loop to step positive rather than negative. this should solve the problem. Moving foorward when you delete cells you only need to increment your row counter when you don't delete a row. Deleting a row will automatically move to the next row. You have to change your loop from a FOR to DO WHILE. N = 0 R = 2 Do While R <= rng.Rows.Count If R Mod 500 = 0 Then Application.StatusBar = "Processing Row: " & Format(R, "#,##0") End If V = rng.Cells(R, 1).Value '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' ' Note that COUNTIF works oddly with a Variant that is equal to vbNullString. ' Rather than pass in the variant, you need to pass in vbNullString explicitly. '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' If V = vbNullString Then If Application.WorksheetFunction. _ CountIf(rng.Columns(1), vbNullString) 1 Then rng.Rows(R).EntireRow.Delete N = N + 1 End If Else If Application.WorksheetFunction. _ CountIf(rng.Columns(1), V) 1 Then rng.Rows(R).EntireRow.Delete N = N + 1 elsse R = R + 1 End If End If Loop End Sub "mikerobe" wrote: Hi I am using the following code to remove duplicate numbers in a column (deleting the whole row of data), but I am having a problem that the record being kept is the most recent by date. I would like to keep the record by date when it was first identified ie the record from January 1st rather than Jan 5th. the following is the code I am using, I apologise in advance if the answer is staring me in the face my knowledge of VBA is pretty basic and this is is code supplied here by another poster to this group (cant remember the persons name so I apologise for not referencing you). Columns("A:A").Select Dim R As Long Dim N As Long Dim V As Variant Dim Rng As Range On Error GoTo EndMacro Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Set Rng = Application.Intersect(ActiveSheet.UsedRange, _ ActiveSheet.Columns(ActiveCell.Column)) Application.StatusBar = "Processing Row: " & Format(Rng.Row, "#,##0") N = 0 For R = Rng.Rows.Count To 2 Step -1 If R Mod 500 = 0 Then Application.StatusBar = "Processing Row: " & Format(R, "#,##0") End If V = Rng.Cells(R, 1).Value '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' ' Note that COUNTIF works oddly with a Variant that is equal to vbNullString. ' Rather than pass in the variant, you need to pass in vbNullString explicitly. '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' If V = vbNullString Then If Application.WorksheetFunction.CountIf(Rng.Columns( 1), vbNullString) 1 Then Rng.Rows(R).EntireRow.Delete N = N + 1 End If Else If Application.WorksheetFunction.CountIf(Rng.Columns( 1), V) 1 Then Rng.Rows(R).EntireRow.Delete N = N + 1 End If End If Next R EndMacro: Application.StatusBar = False Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Thanks very much for any help Eddie Thanks Joel Just cant seem to get this to work as it deletes too many rows (deletes rows I need to keep). The following is an example of the data in the columns (a to f being actual column headings) A B C D E F G 10113 test any X somedata somedtatz 10/08/07 10113 test any X somedata somedtatz 17/08/07 10113 test any X somedata somedtatz 19/08/07 13283 tester all Q somedtatx somedatab 09/06/07 13283 tester all Q somedtatx somedatab 13/06/07 13283 tester all Q somedtatx somedatab 29/06/07 13283 tester all Q somedtatx somedatab 17/06/07 13283 tester all Q somedtatx somedatab 25/06/07 13283 tester all Q somedtatx somedatab 10/06/07 20458 tested some F somedtatq somedataw 20/04/07 20458 tested some F somedtatq somedataw 29/04/07 20458 tested some F somedtatq somedataw 05/04/07 Hoping to be left with A B C D E F G 10113 test any X somedata somedtatz 10/08/07 13283 tester all Q somedtatx somedatab 09/06/07 20458 tested some F somedtatq somedataw 05/04/07 Hope this is clear Thanks Eddie |
|
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Duplicate removal macro keeps newest record
On May 29, 12:14 am, Joel wrote:
Let me explain N and R R - is the current row. It only need to get incrementerd when you don't delete a row N - Is your loop counter. It must be incremented everytime you go through the loop so you know when you get to the last row. Sub test() Set rng = ActiveSheet R = 1 N = 1 With rng LastRow = .Range("A" & Rows.Count).End(xlUp).Row Do While N <= LastRow If R Mod 500 = 0 Then Application.StatusBar = "Processing Row: " & Format(R, "#,##0") End If V = .Cells(R, "A").Value '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' ' Note that COUNTIF works oddly with a Variant that is equal to 'vbNullString. ' Rather than pass in the variant, you need to pass in vbNullString 'explicitly. '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' If V = vbNullString Then If Application.WorksheetFunction. _ CountIf(.Columns(1), vbNullString) 1 Then .Rows(R).Delete End If Else If Application.WorksheetFunction. _ CountIf(.Columns(1), V) 1 Then .Rows(R).Delete Else R = R + 1 End If End If N = N + 1 Loop End With End Sub "mikerobe" wrote: On May 22, 4:31 pm, Joel wrote: I changed you loop to step positive rather than negative. this should solve the problem. Moving foorward when you delete cells you only need to increment your row counter when you don't delete a row. Deleting a row will automatically move to the next row. You have to change your loop from a FOR to DO WHILE. N = 0 R = 2 Do While R <= rng.Rows.Count If R Mod 500 = 0 Then Application.StatusBar = "Processing Row: " & Format(R, "#,##0") End If V = rng.Cells(R, 1).Value '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' ' Note that COUNTIF works oddly with a Variant that is equal to vbNullString. ' Rather than pass in the variant, you need to pass in vbNullString explicitly. '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' If V = vbNullString Then If Application.WorksheetFunction. _ CountIf(rng.Columns(1), vbNullString) 1 Then rng.Rows(R).EntireRow.Delete N = N + 1 End If Else If Application.WorksheetFunction. _ CountIf(rng.Columns(1), V) 1 Then rng.Rows(R).EntireRow.Delete N = N + 1 elsse R = R + 1 End If End If Loop End Sub "mikerobe" wrote: Hi I am using the following code to remove duplicate numbers in a column (deleting the whole row of data), but I am having a problem that the record being kept is the most recent by date. I would like to keep the record by date when it was first identified ie the record from January 1st rather than Jan 5th. the following is the code I am using, I apologise in advance if the answer is staring me in the face my knowledge of VBA is pretty basic and this is is code supplied here by another poster to this group (cant remember the persons name so I apologise for not referencing you). Columns("A:A").Select Dim R As Long Dim N As Long Dim V As Variant Dim Rng As Range On Error GoTo EndMacro Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Set Rng = Application.Intersect(ActiveSheet.UsedRange, _ ActiveSheet.Columns(ActiveCell.Column)) Application.StatusBar = "Processing Row: " & Format(Rng.Row, "#,##0") N = 0 For R = Rng.Rows.Count To 2 Step -1 If R Mod 500 = 0 Then Application.StatusBar = "Processing Row: " & Format(R, "#,##0") End If V = Rng.Cells(R, 1).Value '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' ' Note that COUNTIF works oddly with a Variant that is equal to vbNullString. ' Rather than pass in the variant, you need to pass in vbNullString explicitly. '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' If V = vbNullString Then If Application.WorksheetFunction.CountIf(Rng.Columns( 1), vbNullString) 1 Then Rng.Rows(R).EntireRow.Delete N = N + 1 End If Else If Application.WorksheetFunction.CountIf(Rng.Columns( 1), V) 1 Then Rng.Rows(R).EntireRow.Delete N = N + 1 End If End If Next R EndMacro: Application.StatusBar = False Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Thanks very much for any help Eddie Thanks Joel Just cant seem to get this to work as it deletes too many rows (deletes rows I need to keep). The following is an example of the data in the columns (a to f being actual column headings) A B C D E F G 10113 test any X somedata somedtatz 10/08/07 10113 test any X somedata somedtatz 17/08/07 10113 test any X somedata somedtatz 19/08/07 13283 tester all Q somedtatx somedatab 09/06/07 13283 tester all Q somedtatx somedatab 13/06/07 13283 tester all Q somedtatx somedatab 29/06/07 13283 tester all Q somedtatx somedatab 17/06/07 13283 tester all Q somedtatx somedatab 25/06/07 13283 tester all Q somedtatx somedatab 10/06/07 20458 tested some F somedtatq somedataw 20/04/07 20458 tested some F somedtatq somedataw 29/04/07 20458 tested some F somedtatq somedataw 05/04/07 Hoping to be left with A B C D E F G 10113 test any X somedata somedtatz 10/08/07 13283 tester all Q somedtatx somedatab 09/06/07 20458 tested some F somedtatq somedataw 05/04/07 Hope this is clear Thanks Eddie Hi Joel I ran the macro and it leaves the latest date not the first date, thanks for any more help with this Eddie |
|
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Duplicate removal macro keeps newest record
On May 29, 10:25 pm, mikerobe wrote:
On May 29, 12:14 am, Joel wrote: Let me explain N and R R - is the current row. It only need to get incrementerd when you don't delete a row N - Is your loop counter. It must be incremented everytime you go through the loop so you know when you get to the last row. Sub test() Set rng = ActiveSheet R = 1 N = 1 With rng LastRow = .Range("A" & Rows.Count).End(xlUp).Row Do While N <= LastRow If R Mod 500 = 0 Then Application.StatusBar = "Processing Row: " & Format(R, "#,##0") End If V = .Cells(R, "A").Value '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' ' Note that COUNTIF works oddly with a Variant that is equal to 'vbNullString. ' Rather than pass in the variant, you need to pass in vbNullString 'explicitly. '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' If V = vbNullString Then If Application.WorksheetFunction. _ CountIf(.Columns(1), vbNullString) 1 Then .Rows(R).Delete End If Else If Application.WorksheetFunction. _ CountIf(.Columns(1), V) 1 Then .Rows(R).Delete Else R = R + 1 End If End If N = N + 1 Loop End With End Sub "mikerobe" wrote: On May 22, 4:31 pm, Joel wrote: I changed you loop to step positive rather than negative. this should solve the problem. Moving foorward when you delete cells you only need to increment your row counter when you don't delete a row. Deleting a row will automatically move to the next row. You have to change your loop from a FOR to DO WHILE. N = 0 R = 2 Do While R <= rng.Rows.Count If R Mod 500 = 0 Then Application.StatusBar = "Processing Row: " & Format(R, "#,##0") End If V = rng.Cells(R, 1).Value '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' ' Note that COUNTIF works oddly with a Variant that is equal to vbNullString. ' Rather than pass in the variant, you need to pass in vbNullString explicitly. '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' If V = vbNullString Then If Application.WorksheetFunction. _ CountIf(rng.Columns(1), vbNullString) 1 Then rng.Rows(R).EntireRow.Delete N = N + 1 End If Else If Application.WorksheetFunction. _ CountIf(rng.Columns(1), V) 1 Then rng.Rows(R).EntireRow.Delete N = N + 1 elsse R = R + 1 End If End If Loop End Sub "mikerobe" wrote: Hi I am using the following code to remove duplicate numbers in a column (deleting the whole row of data), but I am having a problem that the record being kept is the most recent by date. I would like to keep the record by date when it was first identified ie the record from January 1st rather than Jan 5th. the following is the code I am using, I apologise in advance if the answer is staring me in the face my knowledge of VBA is pretty basic and this is is code supplied here by another poster to this group (cant remember the persons name so I apologise for not referencing you). Columns("A:A").Select Dim R As Long Dim N As Long Dim V As Variant Dim Rng As Range On Error GoTo EndMacro Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Set Rng = Application.Intersect(ActiveSheet.UsedRange, _ ActiveSheet.Columns(ActiveCell.Column)) Application.StatusBar = "Processing Row: " & Format(Rng.Row, "#,##0") N = 0 For R = Rng.Rows.Count To 2 Step -1 If R Mod 500 = 0 Then Application.StatusBar = "Processing Row: " & Format(R, "#,##0") End If V = Rng.Cells(R, 1).Value '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' ' Note that COUNTIF works oddly with a Variant that is equal to vbNullString. ' Rather than pass in the variant, you need to pass in vbNullString explicitly. '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' If V = vbNullString Then If Application.WorksheetFunction.CountIf(Rng.Columns( 1), vbNullString) 1 Then Rng.Rows(R).EntireRow.Delete N = N + 1 End If Else If Application.WorksheetFunction.CountIf(Rng.Columns( 1), V) 1 Then Rng.Rows(R).EntireRow.Delete N = N + 1 End If End If Next R EndMacro: Application.StatusBar = False Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Thanks very much for any help Eddie Thanks Joel Just cant seem to get this to work as it deletes too many rows (deletes rows I need to keep). The following is an example of the data in the columns (a to f being actual column headings) A B C D E F G 10113 test any X somedata somedtatz 10/08/07 10113 test any X somedata somedtatz 17/08/07 10113 test any X somedata somedtatz 19/08/07 13283 tester all Q somedtatx somedatab 09/06/07 13283 tester all Q somedtatx somedatab 13/06/07 13283 tester all Q somedtatx somedatab 29/06/07 13283 tester all Q somedtatx somedatab 17/06/07 13283 tester all Q somedtatx somedatab 25/06/07 13283 tester all Q somedtatx somedatab 10/06/07 20458 tested some F somedtatq somedataw 20/04/07 20458 tested some F somedtatq somedataw 29/04/07 20458 tested some F somedtatq somedataw 05/04/07 Hoping to be left with A B C D E F G 10113 test any X somedata somedtatz 10/08/07 13283 tester all Q somedtatx somedatab 09/06/07 20458 tested some F somedtatq somedataw 05/04/07 Hope this is clear Thanks Eddie Hi Joel I ran the macro and it leaves the latest date not the first date, thanks for any more help with this Eddie Hi again Joel Got this sorted added a little script to dort date descending and that did it Thanks Eddie |
|
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Duplicate removal macro keeps newest record
Sub test()
Set rng = ActiveSheet R = 1 N = 1 With rng LastRow = .Range("A" & Rows.Count).End(xlUp).Row Do While N <= LastRow If R Mod 500 = 0 Then Application.StatusBar = "Processing Row: " & Format(R, "#,##0") End If V = .Range("A" & R).Value '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' ' Note that COUNTIF works oddly with a Variant that is equal to 'vbNullString. ' Rather than pass in the variant, you need to pass in vbNullString 'explicitly. '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' If V = vbNullString Then If Application.WorksheetFunction. _ CountIf(.Columns(1), vbNullString) 1 Then .Rows(R).Delete End If Else Next_V = .Range("A" & (R + 1)).Value If V = Next_V Then Thisdate = .Range("G" & R).Value NextDate = .Range("G" & (R + 1)).Value If Thisdate < NextDate Then .Rows(R + 1).Delete Else .Rows(R).Delete End If Else R = R + 1 End If End If N = N + 1 Loop End With End Sub "Joel" wrote: Let me explain N and R R - is the current row. It only need to get incrementerd when you don't delete a row N - Is your loop counter. It must be incremented everytime you go through the loop so you know when you get to the last row. Sub test() Set rng = ActiveSheet R = 1 N = 1 With rng LastRow = .Range("A" & Rows.Count).End(xlUp).Row Do While N <= LastRow If R Mod 500 = 0 Then Application.StatusBar = "Processing Row: " & Format(R, "#,##0") End If V = .Cells(R, "A").Value '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' ' Note that COUNTIF works oddly with a Variant that is equal to 'vbNullString. ' Rather than pass in the variant, you need to pass in vbNullString 'explicitly. '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' If V = vbNullString Then If Application.WorksheetFunction. _ CountIf(.Columns(1), vbNullString) 1 Then .Rows(R).Delete End If Else If Application.WorksheetFunction. _ CountIf(.Columns(1), V) 1 Then .Rows(R).Delete Else R = R + 1 End If End If N = N + 1 Loop End With End Sub "mikerobe" wrote: On May 22, 4:31 pm, Joel wrote: I changed you loop to step positive rather than negative. this should solve the problem. Moving foorward when you delete cells you only need to increment your row counter when you don't delete a row. Deleting a row will automatically move to the next row. You have to change your loop from a FOR to DO WHILE. N = 0 R = 2 Do While R <= rng.Rows.Count If R Mod 500 = 0 Then Application.StatusBar = "Processing Row: " & Format(R, "#,##0") End If V = rng.Cells(R, 1).Value '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' ' Note that COUNTIF works oddly with a Variant that is equal to vbNullString. ' Rather than pass in the variant, you need to pass in vbNullString explicitly. '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' If V = vbNullString Then If Application.WorksheetFunction. _ CountIf(rng.Columns(1), vbNullString) 1 Then rng.Rows(R).EntireRow.Delete N = N + 1 End If Else If Application.WorksheetFunction. _ CountIf(rng.Columns(1), V) 1 Then rng.Rows(R).EntireRow.Delete N = N + 1 elsse R = R + 1 End If End If Loop End Sub "mikerobe" wrote: Hi I am using the following code to remove duplicate numbers in a column (deleting the whole row of data), but I am having a problem that the record being kept is the most recent by date. I would like to keep the record by date when it was first identified ie the record from January 1st rather than Jan 5th. the following is the code I am using, I apologise in advance if the answer is staring me in the face my knowledge of VBA is pretty basic and this is is code supplied here by another poster to this group (cant remember the persons name so I apologise for not referencing you). Columns("A:A").Select Dim R As Long Dim N As Long Dim V As Variant Dim Rng As Range On Error GoTo EndMacro Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Set Rng = Application.Intersect(ActiveSheet.UsedRange, _ ActiveSheet.Columns(ActiveCell.Column)) Application.StatusBar = "Processing Row: " & Format(Rng.Row, "#,##0") N = 0 For R = Rng.Rows.Count To 2 Step -1 If R Mod 500 = 0 Then Application.StatusBar = "Processing Row: " & Format(R, "#,##0") End If V = Rng.Cells(R, 1).Value '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' ' Note that COUNTIF works oddly with a Variant that is equal to vbNullString. ' Rather than pass in the variant, you need to pass in vbNullString explicitly. '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' If V = vbNullString Then If Application.WorksheetFunction.CountIf(Rng.Columns( 1), vbNullString) 1 Then Rng.Rows(R).EntireRow.Delete N = N + 1 End If Else If Application.WorksheetFunction.CountIf(Rng.Columns( 1), V) 1 Then Rng.Rows(R).EntireRow.Delete N = N + 1 End If End If Next R EndMacro: Application.StatusBar = False Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Thanks very much for any help Eddie Thanks Joel Just cant seem to get this to work as it deletes too many rows (deletes rows I need to keep). The following is an example of the data in the columns (a to f being actual column headings) A B C D E F G 10113 test any X somedata somedtatz 10/08/07 10113 test any X somedata somedtatz 17/08/07 10113 test any X somedata somedtatz 19/08/07 13283 tester all Q somedtatx somedatab 09/06/07 13283 tester all Q somedtatx somedatab 13/06/07 13283 tester all Q somedtatx somedatab 29/06/07 13283 tester all Q somedtatx somedatab 17/06/07 13283 tester all Q somedtatx somedatab 25/06/07 13283 tester all Q somedtatx somedatab 10/06/07 20458 tested some F somedtatq somedataw 20/04/07 20458 tested some F somedtatq somedataw 29/04/07 20458 tested some F somedtatq somedataw 05/04/07 Hoping to be left with A B C D E F G 10113 test any X somedata somedtatz 10/08/07 13283 tester all Q somedtatx somedatab 09/06/07 20458 tested some F somedtatq somedataw 05/04/07 Hope this is clear Thanks Eddie |
|
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Duplicate removal macro keeps newest record
On May 30, 4:00*am, Joel wrote:
Sub test() Set rng = ActiveSheet R = 1 N = 1 With rng * *LastRow = .Range("A" & Rows.Count).End(xlUp).Row * *Do While N <= LastRow * * * If R Mod 500 = 0 Then * * * * *Application.StatusBar = "Processing Row: " & Format(R, "#,##0") * * * End If * * * V = .Range("A" & R).Value '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' ' Note that COUNTIF works oddly with a Variant that is equal to 'vbNullString. ' Rather than pass in the variant, you need to pass in vbNullString 'explicitly. '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' * * * If V = vbNullString Then * * * * *If Application.WorksheetFunction. _ * * * * * * CountIf(.Columns(1), vbNullString) 1 Then * * * * * * .Rows(R).Delete * * * * *End If * * * Else * * * * *Next_V = .Range("A" & (R + 1)).Value * * * * *If V = Next_V Then * * * * * * Thisdate = .Range("G" & R).Value * * * * * * NextDate = .Range("G" & (R + 1)).Value * * * * * * If Thisdate < NextDate Then * * * * * * * *.Rows(R + 1).Delete * * * * * * Else * * * * * * * *.Rows(R).Delete * * * * * * End If * * * * *Else * * * * * * R = R + 1 * * * * *End If * * * End If * * * N = N + 1 * *Loop End With End Sub "Joel" wrote: Let me explain N and R R - is the current row. *It only need to get incrementerd when you don't delete a row N - Is your loop counter. *It must be incremented everytime you go through the loop so you know when you get to the last row. Sub test() Set rng = ActiveSheet R = 1 N = 1 With rng * *LastRow = .Range("A" & Rows.Count).End(xlUp).Row * *Do While N <= LastRow * * * If R Mod 500 = 0 Then * * * * *Application.StatusBar = "Processing Row: " & Format(R, "#,##0") * * * End If * * * V = .Cells(R, "A").Value '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' ' Note that COUNTIF works oddly with a Variant that is equal to 'vbNullString. ' Rather than pass in the variant, you need to pass in vbNullString 'explicitly. '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' * * * If V = vbNullString Then * * * * *If Application.WorksheetFunction. _ * * * * * * CountIf(.Columns(1), vbNullString) 1 Then * * * * * * .Rows(R).Delete * * * * *End If * * * Else * * * * *If Application.WorksheetFunction. _ * * * * * * CountIf(.Columns(1), V) 1 Then * * * * * * .Rows(R).Delete * * * * *Else * * * * * * R = R + 1 * * * * *End If * * * End If * * * N = N + 1 * *Loop End With End Sub "mikerobe" wrote: On May 22, 4:31 pm, Joel wrote: I changed you loop to step positive rather than negative. *this should solve the problem. *Moving foorward when you delete cells you only need to increment your row counter when you don't delete a row. *Deleting a row will automatically move to the next row. *You have to change your loop from a FOR to DO WHILE. N = 0 R = 2 Do While R <= rng.Rows.Count * *If R Mod 500 = 0 Then * * * Application.StatusBar = "Processing Row: " & Format(R, "#,##0") * *End If * *V = rng.Cells(R, 1).Value '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' ' Note that COUNTIF works oddly with a Variant that is equal to vbNullString. ' Rather than pass in the variant, you need to pass in vbNullString explicitly. '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' * *If V = vbNullString Then * * * *If Application.WorksheetFunction. _ * * * * * CountIf(rng.Columns(1), vbNullString) 1 Then * * * * * rng.Rows(R).EntireRow.Delete * * * * * N = N + 1 * * * *End If * *Else * * * If Application.WorksheetFunction. _ * * * * *CountIf(rng.Columns(1), V) 1 Then * * * * rng.Rows(R).EntireRow.Delete * * * * N = N + 1 * * * elsse * * * R = R + 1 * * * End If * *End If Loop End Sub "mikerobe" wrote: Hi I am using the following code to remove duplicate numbers in a column (deleting the whole row of data), but I am having a problem that the record being kept is the most recent by date. I would like to keep the record by date when it was first identified ie the record from January 1st rather than Jan 5th. the following is the code I am using, I apologise in advance if the answer is staring me in the face my knowledge of VBA is pretty basic and this is is code supplied here by another poster to this group (cant remember the persons name so I apologise for not referencing you). Columns("A:A").Select * * Dim R As Long Dim N As Long Dim V As Variant Dim Rng As Range On Error GoTo EndMacro Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Set Rng = Application.Intersect(ActiveSheet.UsedRange, _ * * * * * * * * * * ActiveSheet.Columns(ActiveCell.Column)) Application.StatusBar = "Processing Row: " & Format(Rng.Row, "#,##0") N = 0 For R = Rng.Rows.Count To 2 Step -1 If R Mod 500 = 0 Then * * Application.StatusBar = "Processing Row: " & Format(R, "#,##0") End If V = Rng.Cells(R, 1).Value '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' ' Note that COUNTIF works oddly with a Variant that is equal to vbNullString. ' Rather than pass in the variant, you need to pass in vbNullString explicitly. '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' If V = vbNullString Then * * If Application.WorksheetFunction.CountIf(Rng.Columns( 1), vbNullString) 1 Then * * * * Rng.Rows(R).EntireRow.Delete * * * * N = N + 1 * * End If Else * * If Application.WorksheetFunction.CountIf(Rng.Columns( 1), V) 1 Then * * * * Rng.Rows(R).EntireRow.Delete * * * * N = N + 1 * * End If End If Next R EndMacro: Application.StatusBar = False Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Thanks very much for any help Eddie Thanks Joel Just cant seem to get this to work as it deletes too many rows (deletes rows I need to keep). The following is an example of the data in the columns (a to f being actual column headings) A * * * *B * * * C * * * *D * * * E * * * * * * * * * *F * * * * * * * * * * G 10113 test * *any * * X * * * somedata * * * *somedtatz * * * 10/08/07 10113 test * *any * * X * * * somedata * * * *somedtatz * * * 17/08/07 10113 test * *any * * X * * * somedata * * * *somedtatz * * * 19/08/07 13283 tester *all * * Q * * * somedtatx * * * somedatab * * * 09/06/07 13283 tester *all * * Q * * * somedtatx * * * somedatab * * * 13/06/07 13283 tester *all * * Q * * * somedtatx * * * somedatab * * * 29/06/07 13283 tester *all * * Q * * * somedtatx * * * somedatab * * * 17/06/07 13283 tester *all * * Q * * * somedtatx * * * somedatab * * * 25/06/07 13283 tester *all * * Q * * * somedtatx * * * somedatab * * * 10/06/07 20458 tested *some * *F * somedtatq * somedataw * * * 20/04/07 20458 tested *some * *F * somedtatq * somedataw * * * 29/04/07 20458 tested *some * *F * somedtatq * somedataw * * * 05/04/07 Hoping to be left with A * * * *B * * * C * * * D * * * *E * * * * * * * * * *F * * * * * * * * * *G 10113 test * *any * * X * * * somedata * * * *somedtatz * * * 10/08/07 13283 tester *all * * Q * * * somedtatx * * * somedatab * * * 09/06/07 20458 tested *some * *F * somedtatq * somedataw * * * 05/04/07 Hope this is clear Thanks Eddie- Hide quoted text - - Show quoted text - Works even better Joel thanks for all you help over the last few days |
|
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Duplicate removal macro keeps newest record
Deleteig rows individually takes a lot of time. It is better to mark the
rows you need to dele3te then delte the rows all at once. the modified code below puts the word delete in column H and then removes all rows with data in column H. This code will run 10 times faster. Sub test() Set rng = ActiveSheet R = 1 N = 1 With rng LastRow = .Range("A" & Rows.Count).End(xlUp).Row Do While N <= LastRow If R Mod 500 = 0 Then Application.StatusBar = "Processing Row: " & Format(R, "#,##0") End If V = .Range("A" & R).Value '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' ' Note that COUNTIF works oddly with a Variant that is equal to 'vbNullString. ' Rather than pass in the variant, you need to pass in vbNullString 'explicitly. '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' If V = vbNullString Then If Application.WorksheetFunction. _ CountIf(.Columns(1), vbNullString) 1 Then .Range("H" & R) = "delete" '.Rows(R).Delete End If Else Next_V = .Range("A" & (R + 1)).Value If V = Next_V Then Thisdate = .Range("G" & R).Value NextDate = .Range("G" & (R + 1)).Value If Thisdate < NextDate Then .Range("H" & (R + 1)) = "delete" '.Rows(R + 1).Delete Else .Range("H" & R) = "delete" '.Rows(R).Delete End If Else R = R + 1 End If End If N = N + 1 Loop End With Set DeleteRows = Columns("H").SpecialCells(xlCellTypeConstants) DeleteRows.EntireRow.Delete End Sub "mikerobe" wrote: On May 30, 4:00 am, Joel wrote: Sub test() Set rng = ActiveSheet R = 1 N = 1 With rng LastRow = .Range("A" & Rows.Count).End(xlUp).Row Do While N <= LastRow If R Mod 500 = 0 Then Application.StatusBar = "Processing Row: " & Format(R, "#,##0") End If V = .Range("A" & R).Value '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' ' Note that COUNTIF works oddly with a Variant that is equal to 'vbNullString. ' Rather than pass in the variant, you need to pass in vbNullString 'explicitly. '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' If V = vbNullString Then If Application.WorksheetFunction. _ CountIf(.Columns(1), vbNullString) 1 Then .Rows(R).Delete End If Else Next_V = .Range("A" & (R + 1)).Value If V = Next_V Then Thisdate = .Range("G" & R).Value NextDate = .Range("G" & (R + 1)).Value If Thisdate < NextDate Then .Rows(R + 1).Delete Else .Rows(R).Delete End If Else R = R + 1 End If End If N = N + 1 Loop End With End Sub "Joel" wrote: Let me explain N and R R - is the current row. It only need to get incrementerd when you don't delete a row N - Is your loop counter. It must be incremented everytime you go through the loop so you know when you get to the last row. Sub test() Set rng = ActiveSheet R = 1 N = 1 With rng LastRow = .Range("A" & Rows.Count).End(xlUp).Row Do While N <= LastRow If R Mod 500 = 0 Then Application.StatusBar = "Processing Row: " & Format(R, "#,##0") End If V = .Cells(R, "A").Value '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' ' Note that COUNTIF works oddly with a Variant that is equal to 'vbNullString. ' Rather than pass in the variant, you need to pass in vbNullString 'explicitly. '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' If V = vbNullString Then If Application.WorksheetFunction. _ CountIf(.Columns(1), vbNullString) 1 Then .Rows(R).Delete End If Else If Application.WorksheetFunction. _ CountIf(.Columns(1), V) 1 Then .Rows(R).Delete Else R = R + 1 End If End If N = N + 1 Loop End With End Sub "mikerobe" wrote: On May 22, 4:31 pm, Joel wrote: I changed you loop to step positive rather than negative. this should solve the problem. Moving foorward when you delete cells you only need to increment your row counter when you don't delete a row. Deleting a row will automatically move to the next row. You have to change your loop from a FOR to DO WHILE. N = 0 R = 2 Do While R <= rng.Rows.Count If R Mod 500 = 0 Then Application.StatusBar = "Processing Row: " & Format(R, "#,##0") End If V = rng.Cells(R, 1).Value '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' ' Note that COUNTIF works oddly with a Variant that is equal to vbNullString. ' Rather than pass in the variant, you need to pass in vbNullString explicitly. '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' If V = vbNullString Then If Application.WorksheetFunction. _ CountIf(rng.Columns(1), vbNullString) 1 Then rng.Rows(R).EntireRow.Delete N = N + 1 End If Else If Application.WorksheetFunction. _ CountIf(rng.Columns(1), V) 1 Then rng.Rows(R).EntireRow.Delete N = N + 1 elsse R = R + 1 End If End If Loop End Sub "mikerobe" wrote: Hi I am using the following code to remove duplicate numbers in a column (deleting the whole row of data), but I am having a problem that the record being kept is the most recent by date. I would like to keep the record by date when it was first identified ie the record from January 1st rather than Jan 5th. the following is the code I am using, I apologise in advance if the answer is staring me in the face my knowledge of VBA is pretty basic and this is is code supplied here by another poster to this group (cant remember the persons name so I apologise for not referencing you). Columns("A:A").Select Dim R As Long Dim N As Long Dim V As Variant Dim Rng As Range On Error GoTo EndMacro Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Set Rng = Application.Intersect(ActiveSheet.UsedRange, _ ActiveSheet.Columns(ActiveCell.Column)) Application.StatusBar = "Processing Row: " & Format(Rng.Row, "#,##0") N = 0 For R = Rng.Rows.Count To 2 Step -1 If R Mod 500 = 0 Then Application.StatusBar = "Processing Row: " & Format(R, "#,##0") End If V = Rng.Cells(R, 1).Value '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' ' Note that COUNTIF works oddly with a Variant that is equal to vbNullString. ' Rather than pass in the variant, you need to pass in vbNullString explicitly. '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' If V = vbNullString Then If Application.WorksheetFunction.CountIf(Rng.Columns( 1), vbNullString) 1 Then Rng.Rows(R).EntireRow.Delete N = N + 1 End If Else If Application.WorksheetFunction.CountIf(Rng.Columns( 1), V) 1 Then Rng.Rows(R).EntireRow.Delete N = N + 1 End If End If Next R EndMacro: Application.StatusBar = False Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Thanks very much for any help Eddie Thanks Joel Just cant seem to get this to work as it deletes too many rows (deletes rows I need to keep). The following is an example of the data in the columns (a to f being actual column headings) A B C D E F G 10113 test any X somedata somedtatz 10/08/07 10113 test any X somedata somedtatz 17/08/07 10113 test any X somedata somedtatz 19/08/07 13283 tester all Q somedtatx somedatab 09/06/07 13283 tester all Q somedtatx somedatab 13/06/07 13283 tester all Q somedtatx somedatab 29/06/07 13283 tester all Q somedtatx somedatab 17/06/07 13283 tester all Q somedtatx somedatab 25/06/07 13283 tester all Q somedtatx somedatab 10/06/07 20458 tested some F somedtatq somedataw 20/04/07 20458 tested some F somedtatq somedataw 29/04/07 20458 tested some F somedtatq somedataw 05/04/07 Hoping to be left with A B C D E F G 10113 test any X somedata somedtatz 10/08/07 13283 tester all Q somedtatx somedatab 09/06/07 20458 tested some F somedtatq somedataw 05/04/07 Hope this is clear Thanks Eddie- Hide quoted text - - Show quoted text - Works even better Joel thanks for all you help over the last few days |
|
#10
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Duplicate removal macro keeps newest record
My last posting had a mistake. R contains the row number of the earliest
date. Again this code should run quickly. Sub test() Set rng = ActiveSheet N = 1 First = True With rng LastRow = .Range("A" & Rows.Count).End(xlUp).Row Do While N <= LastRow If R Mod 500 = 0 Then Application.StatusBar = "Processing Row: " & Format(R, "#,##0") End If V = .Range("A" & N).Value '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' ' Note that COUNTIF works oddly with a Variant that is equal to 'vbNullString. ' Rather than pass in the variant, you need to pass in vbNullString 'explicitly. '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' If V = vbNullString Then If Application.WorksheetFunction. _ CountIf(.Columns(1), vbNullString) 1 Then .Range("H" & N) = "delete" '.Rows(R).Delete End If Else If First = True Then R = 1 Last_V = .Range("A" & R).Value First = False Else If V = Last_V Then ThisDate = .Range("G" & N).Value LastDate = .Range("G" & R).Value If LastDate < ThisDate Then .Range("H" & N) = "delete" '.Rows(R + 1).Delete Else .Range("H" & R) = "delete" R = N LastDate = .Range("G" & R).Value '.Rows(R).Delete End If Else R = N Last_V = .Range("A" & R).Value LastDate = .Range("G" & R).Value Else End If End If N = N + 1 Loop End With Set DeleteRows = Columns("H").SpecialCells(xlCellTypeConstants) DeleteRows.EntireRow.Delete End Sub "Joel" wrote: Deleteig rows individually takes a lot of time. It is better to mark the rows you need to dele3te then delte the rows all at once. the modified code below puts the word delete in column H and then removes all rows with data in column H. This code will run 10 times faster. Sub test() Set rng = ActiveSheet R = 1 N = 1 With rng LastRow = .Range("A" & Rows.Count).End(xlUp).Row Do While N <= LastRow If R Mod 500 = 0 Then Application.StatusBar = "Processing Row: " & Format(R, "#,##0") End If V = .Range("A" & R).Value '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' ' Note that COUNTIF works oddly with a Variant that is equal to 'vbNullString. ' Rather than pass in the variant, you need to pass in vbNullString 'explicitly. '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' If V = vbNullString Then If Application.WorksheetFunction. _ CountIf(.Columns(1), vbNullString) 1 Then .Range("H" & R) = "delete" '.Rows(R).Delete End If Else Next_V = .Range("A" & (R + 1)).Value If V = Next_V Then Thisdate = .Range("G" & R).Value NextDate = .Range("G" & (R + 1)).Value If Thisdate < NextDate Then .Range("H" & (R + 1)) = "delete" '.Rows(R + 1).Delete Else .Range("H" & R) = "delete" '.Rows(R).Delete End If Else R = R + 1 End If End If N = N + 1 Loop End With Set DeleteRows = Columns("H").SpecialCells(xlCellTypeConstants) DeleteRows.EntireRow.Delete End Sub "mikerobe" wrote: On May 30, 4:00 am, Joel wrote: Sub test() Set rng = ActiveSheet R = 1 N = 1 With rng LastRow = .Range("A" & Rows.Count).End(xlUp).Row Do While N <= LastRow If R Mod 500 = 0 Then Application.StatusBar = "Processing Row: " & Format(R, "#,##0") End If V = .Range("A" & R).Value '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' ' Note that COUNTIF works oddly with a Variant that is equal to 'vbNullString. ' Rather than pass in the variant, you need to pass in vbNullString 'explicitly. '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' If V = vbNullString Then If Application.WorksheetFunction. _ CountIf(.Columns(1), vbNullString) 1 Then .Rows(R).Delete End If Else Next_V = .Range("A" & (R + 1)).Value If V = Next_V Then Thisdate = .Range("G" & R).Value NextDate = .Range("G" & (R + 1)).Value If Thisdate < NextDate Then .Rows(R + 1).Delete Else .Rows(R).Delete End If Else R = R + 1 End If End If N = N + 1 Loop End With End Sub "Joel" wrote: Let me explain N and R R - is the current row. It only need to get incrementerd when you don't delete a row N - Is your loop counter. It must be incremented everytime you go through the loop so you know when you get to the last row. Sub test() Set rng = ActiveSheet R = 1 N = 1 With rng LastRow = .Range("A" & Rows.Count).End(xlUp).Row Do While N <= LastRow If R Mod 500 = 0 Then Application.StatusBar = "Processing Row: " & Format(R, "#,##0") End If V = .Cells(R, "A").Value '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' ' Note that COUNTIF works oddly with a Variant that is equal to 'vbNullString. ' Rather than pass in the variant, you need to pass in vbNullString 'explicitly. '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' If V = vbNullString Then If Application.WorksheetFunction. _ CountIf(.Columns(1), vbNullString) 1 Then .Rows(R).Delete End If Else If Application.WorksheetFunction. _ CountIf(.Columns(1), V) 1 Then .Rows(R).Delete Else R = R + 1 End If End If N = N + 1 Loop End With End Sub "mikerobe" wrote: On May 22, 4:31 pm, Joel wrote: I changed you loop to step positive rather than negative. this should solve the problem. Moving foorward when you delete cells you only need to increment your row counter when you don't delete a row. Deleting a row will automatically move to the next row. You have to change your loop from a FOR to DO WHILE. N = 0 R = 2 Do While R <= rng.Rows.Count If R Mod 500 = 0 Then Application.StatusBar = "Processing Row: " & Format(R, "#,##0") End If V = rng.Cells(R, 1).Value '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' ' Note that COUNTIF works oddly with a Variant that is equal to vbNullString. ' Rather than pass in the variant, you need to pass in vbNullString explicitly. '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' If V = vbNullString Then If Application.WorksheetFunction. _ CountIf(rng.Columns(1), vbNullString) 1 Then rng.Rows(R).EntireRow.Delete N = N + 1 End If Else If Application.WorksheetFunction. _ CountIf(rng.Columns(1), V) 1 Then rng.Rows(R).EntireRow.Delete N = N + 1 elsse R = R + 1 End If End If Loop End Sub "mikerobe" wrote: Hi I am using the following code to remove duplicate numbers in a column (deleting the whole row of data), but I am having a problem that the record being kept is the most recent by date. I would like to keep the record by date when it was first identified ie the record from January 1st rather than Jan 5th. the following is the code I am using, I apologise in advance if the answer is staring me in the face my knowledge of VBA is pretty basic and this is is code supplied here by another poster to this group (cant remember the persons name so I apologise for not referencing you). Columns("A:A").Select Dim R As Long Dim N As Long Dim V As Variant Dim Rng As Range On Error GoTo EndMacro Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Set Rng = Application.Intersect(ActiveSheet.UsedRange, _ ActiveSheet.Columns(ActiveCell.Column)) Application.StatusBar = "Processing Row: " & Format(Rng.Row, "#,##0") N = 0 For R = Rng.Rows.Count To 2 Step -1 If R Mod 500 = 0 Then Application.StatusBar = "Processing Row: " & Format(R, "#,##0") End If V = Rng.Cells(R, 1).Value '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' ' Note that COUNTIF works oddly with a Variant that is equal to vbNullString. ' Rather than pass in the variant, you need to pass in vbNullString explicitly. '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' If V = vbNullString Then If Application.WorksheetFunction.CountIf(Rng.Columns( 1), vbNullString) 1 Then Rng.Rows(R).EntireRow.Delete N = N + 1 End If Else If Application.WorksheetFunction.CountIf(Rng.Columns( 1), V) 1 Then Rng.Rows(R).EntireRow.Delete N = N + 1 End If End If Next R EndMacro: Application.StatusBar = False Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Thanks very much for any help Eddie Thanks Joel Just cant seem to get this to work as it deletes too many rows (deletes rows I need to keep). The following is an example of the data in the columns (a to f being actual column headings) A B C D E F G 10113 test any X somedata somedtatz 10/08/07 10113 test any X somedata somedtatz 17/08/07 10113 test any X somedata somedtatz 19/08/07 13283 tester all Q somedtatx somedatab 09/06/07 13283 tester all Q somedtatx somedatab 13/06/07 13283 tester all Q somedtatx somedatab 29/06/07 13283 tester all Q somedtatx somedatab 17/06/07 13283 tester all Q somedtatx somedatab 25/06/07 13283 tester all Q somedtatx somedatab 10/06/07 20458 tested some F somedtatq somedataw 20/04/07 20458 tested some F somedtatq somedataw 29/04/07 20458 tested some F somedtatq somedataw 05/04/07 Hoping to be left with A B C D E F G 10113 test any X somedata somedtatz 10/08/07 13283 tester all Q somedtatx somedatab 09/06/07 20458 tested some F somedtatq somedataw 05/04/07 Hope this is clear Thanks Eddie- Hide quoted text - - Show quoted text - Works even better Joel thanks for all you help over the last few days |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| Linking cells/duplicate removal | Excel Discussion (Misc queries) | |||
| Auto Removal Of Duplicate Rows | Excel Worksheet Functions | |||
| macro that identify the newest file in a folder and open it. | Excel Programming | |||
| exel macro to eliminate duplicate record | Excel Programming | |||
| Duplicate Row Removal Solution | Excel Programming | |||
Linear Mode
