heath9916
asked on
Using Excel VBA to delete duplicate rows of data
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
\\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
' 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
'*************'
'ERROR HANDLER'
'*************'
Exit Sub
canceled:
Range("A1").Select
Application.ScreenUpdating
MsgBox "Operation canceled by user.", vbInformation Or vbOKOnly, "Canceled"
End Sub
\\END CODE\\
Thanks!
heath
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
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:=xlPreviou s, _
SearchOrder:=xlByRows).Row
End With
End Function
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:=xlPreviou
SearchOrder:=xlByRows).Row
End With
End Function
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