Home > other >  VBA Excel - Remove Duplicates in both columns
VBA Excel - Remove Duplicates in both columns

Time:12-14

I have a dataset with two columns as below. The values A, B and C are duplicates and I want them removed in both columns by using VBA, and end up with the table as shown in second table.

Column 1    Column 2
a           b
c           x
f           z
b           a
e           c
d           y
Column 1    Column 2
f           x
e           z
d           y

I have tried working with the Remove.Duplicates method, but this did not work. Even when I made sure the duplicates were in the same row

ActiveSheet.Range("A:B").RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes

Any suggestions?

CodePudding user response:

If I understand you correctly... maybe something like this

Sub test()
Dim rg As Range: Dim rgDel As Range: Dim cell As Range
Dim arr: Dim el

'set the range of data - change if needed
Set rg = Range("A2", Range("B" & Rows.Count).End(xlUp))

'create arr variable which contains only unique value
Set arr = CreateObject("scripting.dictionary")
For Each cell In rg: arr.Item(cell.Value) = 1: Next

'loop to each element in arr as el variable
'get the range of cell/s which value is the looped element as rgDel variable
'check if the count of rgDel is >= 2 then delete shift up the rgDel
'if the count is < 2 then replace back the "TRUE" value to el
For Each el In arr
    With rg
        .Replace el, True, xlWhole, , False, , False, False
        Set rgDel = .SpecialCells(xlConstants, xlLogical)
        If Application.CountA(rgDel) >= 2 Then
            rgDel.Delete Shift:=xlUp
        Else
            .Replace True, el, xlWhole, , False, , False, False
        End If
    End With
Next
End Sub
  • Related