VBA matchFoundIndex and activecell.entirerow.delete issue

[ronnierunfast]

Hi all,

I have the following code but it doesn't delete all duplicates, only some. If it is run several times it does eventually remove all duplicates but not on initial running of code.
The code works fine if i replace:
Cells(iCntr, 4).Activate
ActiveCell.EntireRow.Delete
with:
Cells(iCntr, 5) = "Duplicate"

I have also tried:
Cells(iCntr, 4).Offset(-1,0).Activate
ActiveCell.Offset(1,0).EntireRow.Delete
in case it was an issue with looping through after the row was deleted.




Any pointers would be appreciated!

Sub DeleteDuplicates()


Dim wsweek As Worksheet
Set wsweek = ActiveWorkbook.Worksheets("weekly")
Set week = wsweek.Range("A3")


wsweek.Activate


'Declaring the lastRow variable as Long to store the last row value in the Column1
    Dim LastRow As Long


'matchFoundIndex is to store the match index values of the given value
    Dim matchFoundIndex As Long


'iCntr is to loop through all the records in the column 1 using For loop
    Dim iCntr As Long


'Finding the last row in the Column 1
    LastRow = Range("A65000").End(xlUp).Row


'looping through the column D = 4
    For iCntr = 4 To LastRow
        'checking if the cell is having any item, skipping if it is blank.
        If Cells(iCntr, 4) <> "" Then
            'getting match index number for the value of the cell
            matchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 4), Range("D1:D" & LastRow), 0)
            'if the match index is not equals to current row number, then it is a duplicate value
            If iCntr <> matchFoundIndex Then
            
[B][COLOR=#00ff00]            'NEW CODE FOR DELETING DUPLICATES[/COLOR][/B]
[COLOR=#ff0000]            Cells(iCntr, 4).Activate[/COLOR]
[COLOR=#ff0000]            ActiveCell.EntireRow.Delete[/COLOR]


[B][COLOR=#00ff00]             'END OF NEW CODE FOR DELETING DUPLICATES[/COLOR][/B]
             
           
        End If
     End If
    Next
End Sub

 

[Fluff]

Try

Sub DeleteDuplicates()
   Dim wsweek As Worksheet
   Dim LastRow As Long
   Dim matchFoundIndex As Long
   Dim iCntr As Long
   
   Set wsweek = ActiveWorkbook.Worksheets("weekly")
   Set week = wsweek.Range("A3")
   
   With wsweek
      LastRow = .Range("A65000").End(xlUp).Row
      'looping through the column D = 4
      For iCntr = LastRow To 4 Step -1
         'checking if the cell is having any item, skipping if it is blank.
         If .Cells(iCntr, 4) <> "" Then
            'getting match index number for the value of the cell
            matchFoundIndex = WorksheetFunction.Match(.Cells(iCntr, 4), .Range("D1:D" & LastRow), 0)
            'if the match index is not equals to current row number, then it is a duplicate value
            If iCntr <> matchFoundIndex Then
            'NEW CODE FOR DELETING DUPLICATES
            .Rows(iCntr).Delete
            'END OF NEW CODE FOR DELETING DUPLICATES
            End If
         End If
      Next
   End With
End Sub

 

[ronnierunfast]

Thanks fluff for the fast reply.

it did similar to my code where it didn't delete all duplicates in one go, but using your code i amended it slightly to do what i was trying with offset(1,0):

Rows(iCntr).Delete
iCntr = iCntr - 1

this then deleted all duplicates in one go!!!

thank you!!!

 

[ronnierunfast]

now how do i mark this post as resolved....????

 

[Fluff]

Glad to help & thanks for the feedback

now how do i mark this post as resolved....????

You can't. We don't mark threads as solved on this board.

 

[ronnierunfast]

Phew, thought i was missing a simple trick again!!