?
Solved

Using Excel VBA to delete duplicate rows of data

Posted on 2005-04-28
6
Medium Priority
?
18,920 Views
Last Modified: 2008-01-09
I am trying to create a module that will allow me to delete duplicate rows of data.  The code that I have is below, but it seems that the for-next statement never finishes.  Any assistance anyone can give would be greatly appreciated.

\\BEGIN CODE\\
Option Explicit
Sub DeleteDuplicates()
'   Variable declaration
    Dim lngRow As Long, lngColumn As Long
    Dim lngEnd As Long
   
'   Turn off screen updating
    Application.ScreenUpdating = False
   
'   Set error handling
    On Error GoTo canceled:

'   Set begin and end row to same value
    lngRow = 2
    lngEnd = lngRow

'   Determine the range of used cells
    Do While Cells((lngEnd + 1), 1) <> ""
        lngEnd = lngEnd + 1
    Loop
   
'   Ask the user what column should be tested for duplicate values
    lngColumn = InputBox("Which column should be" & vbNewLine & _
        "checked for duplicates?", "Not so fast...")
       
'   Begin the process of removing duplicates
    For lngRow = 2 To lngEnd
        If Cells(lngRow, lngColumn) = Cells(lngRow - 1, lngColumn) Then
            Rows(lngRow).Select
            Selection.Delete
            lngRow = lngRow - 1
        End If
    Next lngRow

'   Turn on screen updating
    Application.ScreenUpdating = True

'*************'
'ERROR HANDLER'
'*************'
Exit Sub
canceled:
Range("A1").Select
Application.ScreenUpdating = True
MsgBox "Operation canceled by user.", vbInformation Or vbOKOnly, "Canceled"

End Sub

\\END CODE\\

Thanks!

heath

0
Comment
Question by:heath9916
3 Comments
 
LVL 35

Accepted Solution

by:
mvidas earned 500 total points
ID: 13886855
Hi Heath,

I changed the method of checking for the duplicates, but you'll find this runs much faster and more efficient.  Please let me know if you have any questions!

Option Explicit
Sub DeleteDuplicates()
'Variable declaration
 Dim StartRow As Long, CheckRG As Range, ColToCheck As Range
 Dim UniqCells() As String, UniqCount As Long, i As Long, DelRG As Range
 
'Set row to start searching for duplicates
 StartRow = 2

'Determine the range of used cells
 Set CheckRG = Intersect(Rows(StartRow & ":65536"), ActiveSheet.UsedRange)
 If CheckRG Is Nothing Then Exit Sub 'Nothing to check
 
'Ask the user what column should be tested for duplicate values
 Do
  Set ColToCheck = Application.InputBox(prompt:="Which column should be" & vbNewLine _
   & "checked for duplicates?", Title:="Please select single column", Type:=8)
 Loop Until ColToCheck.Columns.Count = 1
 
'Begin the process of removing duplicates by loading unique values into string array
' and setting the duplicate rows into a range to delete later on
 UniqCount = 0
 ReDim UniqCells(0)
 For i = 1 To CheckRG.Rows.Count
  If Not InSArray(UniqCells, Intersect(CheckRG.Rows(i).EntireRow, ColToCheck).Text) Then
   ReDim Preserve UniqCells(UniqCount)
   UniqCells(UniqCount) = Intersect(CheckRG.Rows(i).EntireRow, ColToCheck).Text
   UniqCount = UniqCount + 1
  Else
   If DelRG Is Nothing Then
    Set DelRG = CheckRG.Rows(i).EntireRow
   Else
    Set DelRG = Union(DelRG, CheckRG.Rows(i).EntireRow)
   End If
  End If
 Next i
   
'Delete duplicate rows
 If Not DelRG Is Nothing Then 'If there are duplicate cells...
  Application.ScreenUpdating = False 'Turn off screen updating
  DelRG.Delete 'Delete duplicate range
  Application.ScreenUpdating = True 'Turn on screen updating
 End If

End Sub

Function InSArray(ByRef vArray() As String, ByVal vValue As String) As Boolean
 Dim i As Long
 For i = LBound(vArray) To UBound(vArray)
  If vArray(i) = vValue Then
   InSArray = True
   Exit Function
  End If
 Next i
 InSArray = False
End Function

You could also look at "The Duplicate Master", a free excel add-in created by EE's own brettdj: http://members.iinet.net.au/~brettdj

Matt
0
 
LVL 10

Expert Comment

by:PSSUser
ID: 13887359
You could make use of the AutoFilter and a formula:

OutCol =  InputBox("Which column should be" & vbNewLine & "used for the formula?", "Not so fast...","B")
ChkCol = InputBox("Which column should be" & vbNewLine & "checked for duplicates?", "Not so fast...","A")

Do While Cells((lngEnd + 1), 1) <> ""
   lngEnd = lngEnd + 1
Loop

Range(OutCol & "2").Formula = "=IF(" & ChkCol & "2=" & ChkCol & "1,""Y"",""N"")"
Range(OutCol & "2").Select
Selection.AutoFill Destination:=Range(OutCol & "2:" & OutCol & lngEnd ), Type:=xlFillDefault
Cells.Select
Selection.AutoFilter Field:=Range(OutCol & "2").Column, Criteria1:="Y"
Rows("2:" & lngEnd).Select
Selection.Delete Shift:=xlUp
Selection.AutoFilter
0
 
LVL 9

Expert Comment

by:dmang
ID: 13936206
LastRow is a function that will return the last row number of the last row on the worksheet that contains any data (including spaces).

Using your code, with a slight change...
lngend = lastrow(activesheet)

'   Begin the process of removing duplicates
    For lngRow = lngend to 2 step -1
        If Cells(lngRow-1, lngColumn) = Cells(lngRow, lngColumn) Then
            Rows(lngRow).Select
            Selection.Delete
        End If
    Next lngRow


Function LastRow(ws As Worksheet) As Single

    'uses worksheet object
    'returns last used row
 
    On Error Resume Next
   
    With ws
      LastRow = .Cells.Find(What:="*", _
        SearchDirection:=xlPrevious, _
        SearchOrder:=xlByRows).Row
    End With
 
End Function
0

Featured Post

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

When designing a form there are several BorderStyles to choose from, all of which can be classified as either 'Fixed' or 'Sizable' and I'd guess that 'Fixed Single' or one of the other fixed types is the most popular choice. I assume it's the most p…
You can of course define an array to hold data that is of a particular type like an array of Strings to hold customer names or an array of Doubles to hold customer sales, but what do you do if you want to coordinate that data? This article describes…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…
Suggested Courses

850 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question