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