Find Duplicates

[HansV]

How does the list box get populated? Have you set its RowSource property, or do you use the AddItem method?

[adam]

Here's how I have set its RowSource property
=OFFSET(Data!$A$2,0,0,COUNTA(Data!$A:$A),7)

No I do not use addItem method

[HansV]

In the first place, you must set the MultiSelect property of the list box to 1 - fmMultiSelectMulti or 2 - fmMultiSelectExtended.

In the Find_RemoveDuplicates macro, below the line

Cells(cRow, dCol).Interior.Color = vbYellow

insert a new line

UserForm1.ListBox1.Selected(cRow - 2) = True

where UserForm1 is the name of the userform and ListBox1 is the name of the list box.

[adam]

I have tried as told by you Hans. But it does not seem to work.
I have attached the workbook for reference.

Any help would be kindly appreciated.

Thanks in advance.

[HansV]

Because the list box is bound to a range on the worksheet, each change to the range (for example applying a filter) will reset the list box. So we must select the items AFTER looping through the rows.

Here is a modified version of the macro:

Code: Select all

Sub Find_RemoveDuplicates()
  Dim cRow As Long
  Dim lRow As Long
  Dim sCell As Range
  Dim D As Long
  Dim col As New Collection
  Dim itm As Variant
       
  Application.ScreenUpdating = False
  lRow = GetLastRowWithData

  On Error Resume Next
  Set sCell = Application.InputBox(Prompt:= _
    "Select Starting Row of Column with Duplicate values.", _
    Title:="Select Column", Type:=8)
  On Error GoTo 0
  If sCell Is Nothing Then
    Exit Sub
  End If

  If sCell.Cells.Count > 1 Then
    MsgBox ("Pls select Single Cell only")
    Exit Sub
  Else
    dCol = sCell.Column
    sRow = sCell.Row
    For cRow = lRow To sRow Step -1
      If IsEmpty(Cells(cRow, dCol)) = False Then
        If WorksheetFunction.CountIf(Range(sCell, Cells(cRow, dCol)), _
            Cells(cRow, dCol).Text) > 1 Then
          'This Marks the duplicate values as Yellow
          Cells(cRow, dCol).Interior.Color = vbYellow
          col.Add cRow - 2
          Selection.CurrentRegion.AutoFilter Field:=dCol, _
            Criteria1:=vbYellow, Operator:=xlFilterCellColor
          D = D + 1
        End If
      End If
    Next cRow

    If D = 0 Then
      MsgBox "No Duplicate Values Found"
    Else
      For Each itm In col
        frmRemoveDuplicates.ListBox1.Selected(itm) = True
      Next itm

      caution = MsgBox(D & " Duplicate entries selected and marked YELLOW" & _
        vbCrLf & "Do you want to delete them? " & vbCrLf & _
        "Entire Row for the marked entries will be deleted. " & vbCrLf & _
        "Do you want to Continue?", vbYesNo, "Confirmation to Proceed")
      If caution = vbYes Then
        For cRow = lRow To sRow Step -1
          If IsEmpty(Cells(cRow, dCol)) = False Then
            If WorksheetFunction.CountIf(Range(sCell, _
                Cells(cRow, dCol)), Cells(cRow, dCol).Text) > 1 Then
              ' This deletes the entire row
              Cells(cRow, dCol).EntireRow.Delete
            End If
           End If
         Next cRow
       End If
     End If
   End If
   ActiveSheet.ShowAllData
End Sub

Because of the last line in the macro, the selecting (highlighting) in the list box will be canceled at the end of the macro.

[adam]

Because of the last line in the macro, the selecting (highlighting) in the list box will be canceled at the end of the macro.

Thanks for the modification Hans. When I imply your code in a standard module and select the starting row as A2 and click the Ok button I get the message saying no duplicates even when the sheet contains duplicate value. and I get the debug message highlighting the line

Code: Select all

ActiveSheet.ShowAllData

What may be the reason for this?

[HansV]

I don't know why the code didn't find duplicates, it worked for me...

The error message is understandable: if you didn't apply AutoFilter, ActiveSheet.ShowAllData will fail. You can change this line to

Code: Select all

  If ActiveSheet.FilterMode Then
    ActiveSheet.ShowAllData
  End If

[adam]

I did apply auto filter in my sheet Hans. But It didn't work. I did try by removing & by inputting your code. But still it didn't work for me. Its pretty complicated that the same code & workbook is not working for me but for you.

I have attached the workbook for reference. Please let me know if I have missed anything in my version.

[HansV]

You haven't bothered to apply the change I suggested in my previous reply. Why not?

[HansV]

And you have removed the GetLastRowWithData function. Why?

[adam]

You haven't bothered to apply the change I suggested in my previous reply. Why not?

I did try by applying the line

Code: Select all

 If ActiveSheet.FilterMode Then
    ActiveSheet.ShowAllData
  End If

Instead of

Code: Select all

ActiveSheet.ShowAllData

But It didn't work for me.

And you have removed the GetLastRowWithData function. Why?

by referring to the GetLastRowWithData function
do you mean this part

Code: Select all

lRow = GetLastRowWithData

If so I didnt do anything with that.
All I did was to copy the entire version of your code and place it in the standard module with the name RemoveDuplicates.
Meanwhile, If you don't mind, I would be happy if you could post the version of the workbook you are having.

[HansV]

Adam, the code that I posted was only the RemoveDuplicates macro; you shouldn't have removed the rest of the module.

[adam]

Thanks for the help Hans. Finally the code highlights the duplicate values from the list box. But why doesn't the highlighted rows get filtered in the list box same as in the worksheet? so that it would make the user to view only the highlighted rows.

[HansV]

A list box whose RowSource is a range doesn't work that way: even if some of the rows in the range are hidden, they remain visible in the list box. You can't hide items in a list box.

[adam]

Thanks for the reply Hans.

By the way,
Which lines do I have to remove from the macro if I want the message “Select starting row where duplicates exists” not to appear when the “Find Dups” command button is clicked.
The purpose of this is to make the code to search for any duplicate values and filter them for deletion on its own throughout the worksheet, when the “Find Dups” command button is clicked.

[HansV]

In which column do you want to look for duplicates?

[adam]

Column "A" & B if possible. If not column "A".

[HansV]

Checking two columns is more complicated, so we'll stick with checking column A.

The code that asks the user for the column to use is

Code: Select all

  On Error Resume Next
  Set sCell = Application.InputBox(Prompt:= _
    "Select Starting Row of Column with Duplicate values.", _
    Title:="Select Column", Type:=8)
  On Error GoTo 0
  If sCell Is Nothing Then
    Exit Sub
  End If

You can replace this code with one line that sets sCell to the cell where you want to start looking.

[adam]

You can replace this code with one line that sets sCell to the cell where you want to start looking.

Code: Select all

  On Error Resume Next
  Set sCell = "Cell A2"

When I change the code as above I get error message.

and when I either change the code as below I also get error message.

Code: Select all

  On Error Resume Next
  Set sCell = " A2"

[HansV]

You don't need the line

On Error Resume Next

sCell is a variable of type Range. You cannot set it to a string. You must set it to a Range object that refers to cell A2.