Question

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
Was it helpful?

Solution 3

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

OTHER TIPS

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

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.

In Excel 2007

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

Licensed under: CC-BY-SA with attribution
Not affiliated with StackOverflow
scroll top