Remove duplicates from range not removing anything

Question

The following code does not remove any duplicate, what am I missing ?

LastColumn = 10

ws.Range(ws.Cells(1, ws.Range("AY1").Column + LastColumn - 1).Address(), ws.Cells(1, "AY").Address()).RemoveDuplicates

I replaced RemoveDuplicates by .Select to check if the excepted range was selected and it was.

Could you share an example address of the range you are trying to affect e.g. `A1:AY10`? — VBasic2008, Nov 26 '21 at 11:29
You may be missing the column identifier. check here: https://stackoverflow.com/questions/31631231/remove-duplicates-from-range-of-cells-in-excel-vba/31631919 — Brett, Nov 26 '21 at 11:30
@VBasic2008 `$AY$1:$BK$1` is returned by : `ws.Range(ws.Cells(1, ws.Range("AY1").Column + LastRow- 1).Address(), ws.Cells(1, "AY").Address()).Address` — TourEiffel, Nov 26 '21 at 11:31
@TourEiffel: Exactly. But does it make sense that the last row is added to the columns? — VBasic2008, Nov 26 '21 at 11:31
@VBasic2008 Sure it does I have X Name on a same Row and I want to remove duplicate of this row. Is it possible ? LastRow = LastColumn I will edit so it ain't miss leading — TourEiffel, Nov 26 '21 at 11:32
You'll need to test it. I thought I saw this missing from your code `icol=Application.Match("abcd", .Rows(1), 0) With .Cells(1, 1).CurrentRegion.RemoveDuplicates Columns:=icol, Header:=xlYes` — Brett, Nov 26 '21 at 11:34
@VBasic2008 yes but it remain the same, last row = last column — TourEiffel, Nov 26 '21 at 11:34
You can only use `RemoveDuplicates` to remove them in columns, not in rows. But there are other solutions. Will look into it. BTW, defining the range should be done without using `Address`. — VBasic2008, Nov 26 '21 at 11:36
I don't know what you mean by row identifier, but a `row` is just a `column` laying on it's side :p `transpose` might help — Brett, Nov 26 '21 at 11:42
How do you like that duplicate removal to behave? The method does not work on a row. It removes duplicates **on rows of a column**. But it can be replaced with a custom function if we understand what you really want accomplishing. Do you want **keeping only the first occurrence and replace the next duplicate ones with empty cells**? Do you want replacing all duplicates and **keep on the row only the consecutive unique values**? So, what do you want accomplishing, from this point of view? — FaneDuru, Nov 26 '21 at 12:12
@FaneDuru keeping only the first occurrence and replace the next duplicate ones with empty cells is what I want to do — TourEiffel, Nov 26 '21 at 12:37
Then, test the code I already supplied and send some feedback. But take care: It will return below the processed range, for testing reason. I explained what is to be replaced in order to overwrite the existing values... — FaneDuru, Nov 26 '21 at 12:38
@FaneDuru On it, Got also other answer to test. I will leave feedbacks once I did try your code — TourEiffel, Nov 26 '21 at 12:39

score 1 · Answer 1 · answered Nov 26 '21 at 12:02

Remove Row Duplicates

Option Explicit

Sub RemoveRowDuplicates()
    
    Dim ws As Worksheet: Set ws = ActiveSheet ' be more specific
    Dim fCell As Range: Set fCell = ws.Range("AY1")
    Dim lCell As Range: Set lCell = ws.Cells(1, ws.Columns.Count).End(xlToLeft)
    If lCell.Column < fCell.Column Then Exit Sub ' no data in row range
    
    Dim rg As Range: Set rg = ws.Range(fCell, lCell)
    Dim cCount As Long: cCount = rg.Columns.Count
    If cCount < 2 Then Exit Sub ' only one column
    
    Dim sData As Variant: sData = rg.Value ' Source
    
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare ' ignore case i.e. 'A = a'
    
    Dim dData As Variant: ReDim dData(1 To 1, 1 To cCount) ' Dest. (Result)
    
    Dim sValue As Variant
    Dim sc As Long
    Dim dc As Long
    
    For sc = 1 To cCount
        sValue = sData(1, sc)
        If Not IsError(sValue) Then ' is not an error value
            If Len(sValue) > 0 Then ' is not blank
                If Not dict.Exists(sValue) Then ' not found in dictionary
                    dict(sValue) = Empty
                    dc = dc + 1
                    dData(1, dc) = sValue
                'Else ' found in dictionary
                End If
            'Else ' is blank
            End If
        'Else ' is error value
        End If
    Next sc
    
    rg.Value = dData
    
    MsgBox "Found " & dc & " unique values.", vbInformation
    
End Sub

FaneDuru · Accepted Answer · 2021-11-26T12:49:31.797

Please, test the next way. It will keep only the first occurrences and replace with empty cells the next duplicates. The processed result is returned on the next (second) row (for testing reason). If it works as you need, you can simple replace ws.Range("AY2").Resize with ws.Range("AY1").Resize:

Sub removeDuplicatesOnRow() 
   Dim ws As Worksheet, lastColumn As Long, arrCol, i As Long
   lastColumn = 10
   
   Set ws = ActiveSheet
   arrCol = ws.Range(ws.cells(1, ws.Range("AY1").Column + lastColumn - 1), ws.cells(1, "AY")).value
   arrCol = removeDuplKeepEmpty(arrCol)
   ws.Range("AY2").Resize(1, UBound(arrCol, 2)).value = arrCol
End Sub
Function removeDuplKeepEmpty(arr) As Variant
  Dim ar, dict As Object, i As Long
  ReDim ar(1 To 1, 1 To UBound(arr, 2))
  Set dict = CreateObject("Scripting.Dictionary")
   For i = 1 To UBound(arr, 2)
        If Not dict.Exists(arr(1, i)) Then
            dict(arr(1, i)) = 1
            ar(1, i) = arr(1, i)
        Else
            ar(1, i) = ""
        End If
   Next i
   removeDuplKeepEmpty = ar
End Function

If you need to keep only unique values/strings in consecutive columns, the function can be adapted to do it. You did not answer my clarification question on the issue and I assumed that you do not want ruining the columns below the processed row. But, if my supposition is wrong, I can post a code doing the other way...

Remove duplicates from range not removing anything

2 Answers2

Remove Row Duplicates