VBA code to delete Duplicate entries

[Hiport]

Hi, i have a spreadsheet which has around 1500 portfolio codes in COL C7, now in this batch of p'folio codes , there are duplicated p'folios codes i.e

Col C
MHLOIU
MHLOIU
MHLOIU
LEHMAN
LEHMAN
LEHMAN

i need a code that will pick out the duplicated p'folios, then
delete them, but at the same time i do not want any blank cells.

Can this be done via VBA?

 

[DonkeyOte]

Something like this would work...
rw1 = first row to be checked (col C)
co1 = column to be checked (col C)

this code is written in such a way that the data range need not be sorted -- ie could have LEHMAN in C2, C3, C1002 and both C3 and C1002 would be removed without needing to be sorted first.

Sub Delete_Dupes()
Dim rw1 As Long: rw1 = 1
Dim rwx As Long: rwx = rw1
Dim stepx As Integer
Dim co1 As Integer: co1 = 3
Dim bool As Boolean
Do Until Cells(rwx, co1) = ""
    stepx = 1
    If rwx > rw1 Then
        On Error GoTo NewCrit
        bool = IsError(Application.WorksheetFunction.Match(Cells(rwx, co1), Range(Cells(rw1, co1), Cells(rwx - 1, co1)), 0))
        Select Case bool
            Case True
                'no match found thus row = first instance (no delete)
            Case False
                'match found in prior rows therefore duplicate so delete
                Rows(rwx).Delete
                stepx = 0
        End Select
    End If
rwx = rwx + stepx
Loop
Exit Sub

NewCrit:
bool = True
Resume Next
End Sub

 

[Hiport]

Something like this would work...
rw1 = first row to be checked (col C)
co1 = column to be checked (col C)

this code is written in such a way that the data range need not be sorted -- ie could have LEHMAN in C2, C3, C1002 and both C3 and C1002 would be removed without needing to be sorted first.

Sub Delete_Dupes()
Dim rw1 As Long: rw1 = 1
Dim rwx As Long: rwx = rw1
Dim stepx As Integer
Dim co1 As Integer: co1 = 3
Dim bool As Boolean
Do Until Cells(rwx, co1) = ""
    stepx = 1
    If rwx > rw1 Then
        On Error GoTo NewCrit
        bool = IsError(Application.WorksheetFunction.Match(Cells(rwx, co1), Range(Cells(rw1, co1), Cells(rwx - 1, co1)), 0))
        Select Case bool
            Case True
                'no match found thus row = first instance (no delete)
            Case False
                'match found in prior rows therefore duplicate so delete
                Rows(rwx).Delete
                stepx = 0
        End Select
    End If
rwx = rwx + stepx
Loop
Exit Sub
 
NewCrit:
bool = True
Resume Next
End Sub

Awesome mate, thanx for that, code works perfect