Deleting Duplicate Rows (1 Viewer)

[vjmehra]

Can anyone see why this doesn't work?

I have a function (below), which loops through each row and then deletes if it finds a dupe, however for some reason it doesn't seem to work....

I have modified the code slightly, so that rather than deleting the row it simply inserts the word 'delete' in column A if the row is a dupe. This seems to work fine, so there must be something going wrong when it actually comes to deleting the cells or row (I have tried both ways, neither seems to work).

Public Function Delete_rows(row_start As Integer, column As Integer)

Dim row As Integer
Dim Row_count As Integer

row = row_start

Do Until Cells(row, column).Value = ""

If Cells(row, 1).Value = Cells(row + 1, 1).Value And Cells(row, 2).Value = Cells(row + 1, 2).Value And _
Cells(row, 3).Value = Cells(row + 1, 3).Value And Cells(row, 4).Value = Cells(row + 1, 4).Value And _
Cells(row, 5).Value = Cells(row + 1, 5).Value And Cells(row, 6).Value = Cells(row + 1, 6).Value And _
Cells(row, 7).Value = Cells(row + 1, 7).Value And Cells(row, 8).Value = Cells(row + 1, 8).Value Then

'ActiveSheet.Range(row & ":" & row).Delete

'ActiveSheet.Range("a" & row & ":h" & row).Delete Shift:=xlShiftUp

Cells(row, 1).Value = "DELETE"

'Cells(row, 1).EntireRow.Delete Shift:=xlShiftUp

End If

row = row + 1

Loop

Row_count = row


End Function

 

[chergh]

Well first of all it isn't a function as it doesn't return a value.

Secondly don't use variable names such as 'row' and 'column', you haven't even declared your column variable, add option explicit at the very top to make sure you do declare all your variables. However 'row' and 'columns' are both property names in vba, you shouldn't use the names of objects, collections, properties etc. as variables as it's just asking for problems.

When you delete a row in excel then row+1 then becomes row. As you increment your counter after you delete a row it means that you are going to miss a row.

Anyway if all you are wanting are the unique rows then make use of the advancedfilter.

something like this

Sub UniqueRows()

Dim inputRange As Range
Dim outputRange As Range
Dim finalrow As Long
Dim finalcol As Long
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Dim wb As Workbook

Set wb = ThisWorkbook
Set ws1 = wb.Worksheets("Sheet1")
Set ws2 = wb.Worksheets("Sheet2")


'find the last row and column of dataset
finalrow = ws1.Cells(65536, 1).End(xlUp).Row
finalcol = ws1.Cells(1, 255).End(xlToLeft).Column

'set the output range of filter
Set outputRange = ws2.Cells(1, 1)

'set input range
Set inputrange = ws1.Range("A1").Resize(finalrow, finalcol)

'use advanced filter to get unique records
inputrang.AdvancedFilter action:=xlFilterCopy, copytorange:=outputRange, unique:=True

'delete worksheet containing duplicates
Application.DisplayAlerts = False
ws1.Delete
Application.DisplayAlerts = True


End Sub