CODEWITHSUNDEEP
vbaexcelduplicates
user2937812
user2937812

Reputation: 49

How to delete duplicate entries completely

I have a column in excel, using vba I am trying to check if there is a duplicate entry in that column then delete duplicate and also main entry so there will be no value related to that entry anymore. What would be the way to do this ?

 Input column=>

  1
  2
  3
  1
  4
  5
  2

desired output column =>

 3
 4
 5

Actually my entries are text but, I gave numerical example to make it clear

After answers my code became 

Last_Row = ws1.Cells(Rows.Count, "G").End(xlUp).Row

Columns("G:H").Select
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("G2", "G" & Last_Row) _
    , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
    .SetRange Range("G1", "H" & Last_Row)
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
Dim i As Integer

i = 2
While (i < Last_Row + 1 And Not IsEmpty(Cells(i, 7).Value))
If Cells(i, 7) = Cells(i + 1, 7) Then
    Range("G" & i + 1, "H" & i + 1).Delete Shift:=xlUp
    Range("G" & i, "H" & i).Delete Shift:=xlUp
End If

If Not Cells(i, 7) = Cells(i + 1, 7) Then
i = i + 1
End If

Wend

Upvotes: 0

Views: 272

Answers (4)

Jean-Fran&#231;ois Corbett
Jean-Fran&#231;ois Corbett

Reputation: 38540

This works. I haven't tried to optimise it or anything.

Dim v As Variant
Dim vOut As Variant
Dim ditch() As Integer
Dim i As Long, j As Long, n As Long
'Read input column into 2D array
v = Range("A1:A7").Value
'Mark which inputs to ditch (mark as 1 if duplicate, keep at 0 if not)
ReDim ditch(LBound(v, 1) To UBound(v, 1))
For i = LBound(v, 1) To UBound(v, 1)
    For j = i + 1 To UBound(v)
        If ditch(j) = 0 And v(j, 1) = v(i, 1) Then
            ditch(i) = 1
            ditch(j) = 1
        End If
    Next j
Next i
'How many non-duplicates are there?
n = UBound(v, 1) - LBound(v, 1) + 1 - WorksheetFunction.Sum(ditch)
'Put non-duplicates in new 2D array
ReDim vOut(1 To n, 1 To 1)
j = 0
For i = LBound(v, 1) To UBound(v, 1)
    If ditch(i) = 0 Then
        j = j + 1
        vOut(j, 1) = v(i, 1)
    End If
Next i
'Write array to sheet
Range("B1").Resize(n).Value = vOut

Upvotes: 2

user3041160
user3041160

Reputation: 684

Create a macro Excel. Your Data should be in the first column and the worksheet to be called "Sheet1"

Columns("A:A").Select
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A2"), _
    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
    .SetRange Columns("A")
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

Dim i As Integer
Dim b As Boolean

i = 1
b = False
While Cells(i, 1) > 0
    While Cells(i, 1) = Cells(i + 1, 1)
        Rows(i + 1).Delete
        b = True
    Wend
    If b = True Then
        Rows(i).Delete
        b = False
        i = i - 1
    End If
    i = i + 1
Wend

Upvotes: 0

pnuts
pnuts

Reputation: 59495

Not using VBA, a 'helper' column with =COUNTIF(A:A,A1) copied down to suit,if your data starts in Row1, should identify duplicates. Filter on the helper column and delete rows showing values greater than 1 may be suitable for you.

Upvotes: 1

user773423
user773423

Reputation:

In Excel 2007

click the "Data" Tab in the ribbon Highlight your selection click "Remove Duplicates"

Upvotes: 0

Related Questions