0

I want to use VBA to remove duplicates in two columns B and C. E.g. when B1=B2 AND C1=C2, then B2 AND C2 data should be removed. But when B1!=B2 AND C1=C2, B2 AND C2 should not be removed as B2 has different value from B1. Right now I'm using the below code, but it does not do the right thing as I want..it removes the duplicate data in column C only.

Sub ()

Dim rCell As Range

With Worksheets("Sheet1")
  For Each rCell In Range("B1:C20") 
  rCell.EntireColumn.RemoveDuplicates 1
  Next rCell
End With

End Sub

Anyone knows how to change the code to make it work properly?

Thanks in advance!

user2774993
  • 87
  • 1
  • 1
  • 9
  • see my [answer here](http://stackoverflow.com/questions/21660648/excel-check-for-duplicate-rows-based-on-3-columns-and-keep-one-row/21660743#21660743). It should help you. – Dmitry Pavliv Feb 10 '14 at 08:30
  • 1
    i guess @simoco 's answer in that thread covers what you need. (the removeduplicate part). Try to right a code patterned to his, and if you got stuck, re-post it here. or just try this: `Range("B1:C20").RemoveDuplicates Columns:=Array(1, 2), Header:=xlNo` – L42 Feb 10 '14 at 09:03
  • Thank you! I just got what I needed. But I got one more issue..how can I make it remove the duplicates when the text are the same despite it's in upper case or lower case? I know if I use the excel "remove duplicates" option, it will also not consider this as duplicates..just wondering whether there's a solution for this?@L42 – user2774993 Feb 10 '14 at 09:19
  • I think excel will treat lower and upper case char as the same when removing dups. for example, `Data1` is a duplicate of `dAtA1`. – L42 Feb 10 '14 at 09:35
  • Ah I see..it's not because of the upper/lower case, it's because having space so excel treats them as not duplicates. Thanks!@L42 – user2774993 Feb 10 '14 at 09:40

1 Answers1

0

i got you homie....

Sub RemoveDups_Copy(sSheet As String)
Dim vArray As Variant
Dim x As Long, y As Integer
Dim sTest As String

Worksheets(sSheet).Select
x = 1
Do While Cells(x + 1, 1) <> ""
x = x + 1
Loop

lastRow = x
If lastRow = 1 Then lastRow = 2
lastColumn = Cells(1, Columns.Count).End(xlToLeft).Column

ReDim vArray(1 To lastRow, 1 To lastColumn)
Set dRemove = CreateObject("Scripting.Dictionary")
Set dRemoveIndex = CreateObject("Scripting.Dictionary")


For x = 2 To lastRow
    sTest = ""
    For y = 1 To lastColumn
        sTest = sTest & "|" & Cells(x, y).Text
    Next y
    If dRemove(sTest) = "Remove" Then dRemoveIndex(x) = "Remove"
    dRemove(sTest) = "Remove"
Next x

i = 0
For x = 1 To lastRow
    If dRemoveIndex(x) <> "Remove" Then
        i = i + 1
        For y = 1 To lastColumn
            vArray(i, y) = Cells(x, y).Text
        Next y
    End If
Next x

Range(Cells(2, 1), Cells(lastRow, lastColumn)).ClearContents
Call RemoveDups_Paste(1, 1, vArray)

End Sub

Sub RemoveDups_Paste(x As Integer, y As Integer, Arr As Variant)
    Set Rng = Range(Cells(x, y), Cells(UBound(Arr, 1) - LBound(Arr, 1) + x, UBound(Arr, 2) - LBound(Arr, 2) + y))
    Rng.Resize(UBound(Arr, 1) - LBound(Arr, 1) + 1, UBound(Arr, 2) - LBound(Arr, 2) + 1) = Arr
End Sub

This records all the original (or non-dup'd) data into an array, clears the data then pastes it over as a range instead of individually. Should run fast.

Frankie No Naps
  • 1
  • 1