Duplicate removal macro keeps newest record

M

mikerobe

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
 
J

Joel

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
 
M

mikerobe

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
Click to expand...

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
 
J

Joel

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
 
M

mikerobe

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
Click to expand...

Hi Joel
I ran the macro and it leaves the latest date not the first date,
thanks for any more help with this
Eddie
 
M

mikerobe

Hi Joel
I ran the macro and it leaves the latest date not the first date,
thanks for any more help with this
Eddie
Click to expand...

Hi again Joel
Got this sorted added a little script to dort date descending and that
did it

Thanks
Eddie
 
J

Joel

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
 
M

mikerobe

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











- Show quoted text -
Click to expand...

Works even better Joel thanks for all you help over the last few days
 
J

Joel

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
 
J

Joel

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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

delete duplicates macro to color instead of delete 4
Question on a Chip Pearson macro 4
countif usage ? 3
DeleteDuplicateRows: problem with this macro 6
Column is overwritten 4
remove duplicates using vba 2
Deleting duplicate Rows AND the original 4
Excel crash - bug macro? 4

Top