Removing duplicates a column.

[asyamonique]

Hello,
Column A has multiple ID numbers(only digit numbers), but also on same column there are blanks rows and also there are text data's like headers.
Is it possible to get only the ID numbers into the another worksheet (Sheet2 column A) after removing to duplicates?
Many Thanks

 

[Joe4]

I would recommend copying the column to Sheet2.
Then sort it, and all text entries and numeric entries will be separated.
Then you can easily see and delete all the text entries.
You can then use Excel's built-in "Remove Duplicates" functionality to remove the numeric duplicates.

Then you should be left with just the unique numeric values!

 

[asyamonique]

I would recommend copying the column to Sheet2.
Then sort it, and all text entries and numeric entries will be separated.
Then you can easily see and delete all the text entries.
You can then use Excel's built-in "Remove Duplicates" functionality to remove the numeric duplicates.

Then you should be left with just the unique numeric values!

Hello,
Yes I did that but was wondering that is there any vba code for it?
Cheers

 

[Joe4]

Hello,
Yes I did that but was wondering that is there any vba code for it?
Cheers

Yes, but that is the first you have mentioned using VBA to do this.

This code should do that:

Sub MyCleanUpMacro()

    Dim lr As Long, r As Long
    
    Application.ScreenUpdating = False

'   Copy column A to sheet2
    Sheets("Sheet1").Columns("A:A").Copy Sheets("Sheet2").Range("A1")

'   Find last row with data
    Sheets("Sheet2").Activate
    lr = Cells(Rows.Count, "A").End(xlUp).Row

'   Sort column A on Sheet 2
    Range("A1:A" & lr).Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    
'   Remove duplicates
    ActiveSheet.Range("A1:A" & lr).RemoveDuplicates Columns:=1, Header:=xlNo
    
'   Find new last row
    lr = Cells(Rows.Count, "A").End(xlUp).Row
    
'   Remove all text entries from the bottom up
    For r = lr To 1 Step -1
'       Exit loop once you find a numeric entry
        If IsNumeric(Cells(r, "A")) Then
            Exit For
'       Otherwise delete row
        Else
            Rows(r).Delete
        End If
    Next r

    Application.ScreenUpdating = True
    
End Sub

 

[asyamonique]

Yes, but that is the first you have mentioned using VBA to do this.

This code should do that:

Sub MyCleanUpMacro()

    Dim lr As Long, r As Long
   
    Application.ScreenUpdating = False

'   Copy column A to sheet2
    Sheets("Sheet1").Columns("A:A").Copy Sheets("Sheet2").Range("A1")

'   Find last row with data
    Sheets("Sheet2").Activate
    lr = Cells(Rows.Count, "A").End(xlUp).Row

'   Sort column A on Sheet 2
    Range("A1:A" & lr).Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
   
'   Remove duplicates
    ActiveSheet.Range("A1:A" & lr).RemoveDuplicates Columns:=1, Header:=xlNo
   
'   Find new last row
    lr = Cells(Rows.Count, "A").End(xlUp).Row
   
'   Remove all text entries from the bottom up
    For r = lr To 1 Step -1
'       Exit loop once you find a numeric entry
        If IsNumeric(Cells(r, "A")) Then
            Exit For
'       Otherwise delete row
        Else
            Rows(r).Delete
        End If
    Next r

    Application.ScreenUpdating = True
   
End Sub

Thanks.