View Single Post
  #8   Report Post  
Posted to microsoft.public.excel.programming
mikerobe mikerobe is offline
external usenet poster
 
Posts: 27
Default 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