[SOLVED] Delete duplicates

Lithium · #1 07-02-2009, 01:00 PM

Hi, the code in the codebox under here, which I wrote, is supposed to delete all duplicate records in the column. Which column to uniquify is stated in cell Skin!B17. I searched the internet round, and there are different solutions everywhere. I have been unable though to find the right one - so I thought, why not ask here. If you have a solution, I'd be happy to hear it.

Code:

Sub Remove_Duplicates_In_A_Range()
    
    Dim x               As Long
    Dim LastRow         As Long
    
Sheets("VLB").Select

  LastRow = Range("A65536").End(xlUp).Row
    For x = LastRow To 1 Step -1
        If Application.WorksheetFunction.CountIf(Sheets("Skin").Range(B17 & "1:" & B17 & x), Sheets("Skin").Range(B17 & x).Text) > 1 Then
            Sheets("Skin").Range(B17 & x).EntireRow.Delete
        End If
    Next x
     
End Sub

**royUK** · #2 07-02-2009, 01:10 PM

Try this, your range definition looks wrong

Code:

    Dim x      As Long
    Dim Col    As Long
    Dim LastRow As Long

    With Sheets("VLB")
        Col = .Cells(17, 2).Value
        LastRow = .Cells(.rows.count).End(xlUp).Row
End with

With Sheets("Skin")
        For x = LastRow To 1 Step -1
            If Application.WorksheetFunction.CountIf(.Cells(1, _
                             Col), .Cells(LastRow, Col)).Value) > 1 Then
                .Cells(x,Col).EntireRow.Delete
            End If
        Next x

Lithium · #3 07-03-2009, 03:31 AM

Developer gave me a few errors:

the 'End With' was missing
there was one closing bracket too many

I believe I fixed the errors, but now it gives me a 1004:
application-defined or object-defined error. The line, with an asterisk in front of it, is the line which gives the error.

Code:

Sub Remove_Duplicates_In_A_Range()
    
    Dim x      As Long
    Dim Col    As Long
    Dim LastRow As Long

'Define ranges
With Sheets("VLB")
        Col = .Cells(17, 2).Value
        LastRow = .Cells(.Rows.Count).End(xlUp).Row
End With

'Execute removal
With Sheets("Skin")
        For x = LastRow To 1 Step -1
*            If Application.WorksheetFunction.CountIf(.Cells(1, Col), .Cells(LastRow, Col).Value) > 1 Then
                .Cells(x, Col).EntireRow.Delete
            End If
        Next x
End With
End Sub

Lithium · #4 07-04-2009, 08:22 AM

Has anyone got an idea how to clear the error?

Thanks!

shg · #5 07-04-2009, 02:28 PM

Try this (untested):

Code:

Sub RemoveDups()
    Dim iRow    As Long
    Dim iCol    As Long
    Dim iRowEnd As Long

    With Sheets("VLB")
        iCol = .Range("B17").Value
        iRowEnd = .Cells(.Rows.Count).End(xlUp).Row
    End With

    With Sheets("Skin").Columns(iCol)
        For iRow = iRowEnd To 2 Step -1
            If WorksheetFunction.CountIf(Range(.Cells(1), .Cells(iRow - 1)), .Cells(iRow).Value) > 0 Then
                .Cells(iRow).EntireRow.Delete
            End If
        Next iRow
    End With
End Sub

Lithium · #6 07-04-2009, 07:21 PM

Code:

Sub RemoveDups()
    Dim iRow    As Long
    Dim iCol    As Long
    Dim iRowEnd As Long

    With Sheets("VLB")
        iCol = .Range("B17").Value
        iRowEnd = .Cells(.Rows.Count).End(xlUp).Row
    End With

    With Sheets("Skin").Columns(iCol)
        For iRow = iRowEnd To 2 Step -1
            If WorksheetFunction.CountIf(Range(.Cells(1), .Cells(iRow - 1)), .Cells(iRow).Value) > 0 Then
                .Cells(iRow).EntireRow.Delete
            End If
        Next iRow
    End With
End Sub

shg · #7 07-04-2009, 07:32 PM

If B17 contains a string (e.g., "A"), then the column variable has to be either a string or a Variant (which will accommodate a number or a string):

Code:

Sub RemoveDups()
    Dim iRow    As Long
    Dim vCol    As Variant
    Dim iRowEnd As Long

    With Sheets("VLB")
        vCol = .Range("B17").Value
        iRowEnd = .Cells(.Rows.Count).End(xlUp).Row
    End With

    With Worksheets("Skin").Columns(vCol)
        For iRow = iRowEnd To 2 Step -1
            If WorksheetFunction.CountIf(Range(.Cells(1), .Cells(iRow - 1)), .Cells(iRow).Value) > 0 Then
                .Cells(iRow).EntireRow.Delete
            End If
        Next iRow
    End With
End Sub

Lithium · #8 07-05-2009, 04:24 AM

Actually, B17 contains this formula:

Code:

=SUBSTITUTE(ADDRESS(1;MATCH(A17;XML!1:1;0);4);1;"")

shg · #9 07-05-2009, 12:21 PM

What result is returned by the formula?

Lithium · #10 07-05-2009, 02:57 PM

A17 is a string and is a column name of sheet "XML". The value of B17 will be a letter of the alphabet. That letter is equal to the column which has the column name in A17. A17 and B17 are on a different sheet than "XML".

shg · #11 07-05-2009, 04:23 PM

Post a workbook.

Lithium · #12 07-05-2009, 04:35 PM

I've attached the zipfile, it included the xlsm. I'll send the password by PM.

shg · #13 07-05-2009, 06:32 PM

VLB!B17 is empty.

Lithium · #14 07-05-2009, 09:22 PM

Okay, that's not right. It should be on the XML sheet, B17. The sheets got mixed up (purple). The semi-correct code:

Code:

Sub Remove_Duplicates_In_A_Range()
    
    Dim x      As Long
    Dim Col    As Long
    Dim LastRow As Long

'Define ranges
With Sheets("Skin")
        Col = .Cells(17, 2).Value
        LastRow = .Cells(.Rows.Count).End(xlUp).Row
End With

'Execute removal
With Sheets("VLB")
        For x = LastRow To 1 Step -1
            If Application.WorksheetFunction.CountIf(.Cells(1, Col), .Cells(LastRow, Col)).Value > 1 Then
                .Cells(x, Col).EntireRow.Delete
            End If
        Next x
End With
End Sub

shg · #15 07-06-2009, 12:30 AM

How about posting a correct example, mon frere?

Welcome to the Excel Forum

Forum Statistics