Delete duplicate entries in a given row

Question

I want to delete the duplicates in each row, such that there should be no "holes" in the row. What I have is:

Col A    Col B   Col C    Col D    Col E   Col F   Col G
A         B        C        D        A       B       A
J         I        K        J        I       K       I
B         A        B        J        I       K       L

up to 40k rows.
Output required:

Col A    Col B   Col C    Col D    Col E   Col F   Col G
A         B        C        D       
J         I        K        
B         A        J        I       K       L

Zev Spitz · Answer 1 · 2015-09-16T22:21:37.093

I suggest iterating over each row in the range, extracting the values, generating the unique set, and repaste into the row.

The following function takes an array of values and returns the unique values in the array, using a Scripting.Dictionary. Add a reference (Tools -> References...) to the Microsoft Scripting Runtime.

Function Unique(values As Variant) As Variant()
    'Put all the values as keys into a dictionary
    Dim dict As New Scripting.Dictionary, val As Variant
    For Each val In values
        dict(val) = 1
    Next
    Unique = dict.Keys
End Function

Then you can do the following:

Dim rng As Range, row As Range
Set rng = ActiveSheet.UsedRange
For Each row In rng.Rows
    Dim values() As Variant 'We need this to extract the values from the range, and to avoid passing in the range itself
    values = row
    Dim newValues() As Variant
    newValues = Unique(values)
    ReDim Preserve newValues(UBound(values, 2)) 'without this, the array will be smaller than the row, and Excel will fill the unmatched cells with #N/A
    row = newValues
Next

Hey sorry but I am not that advance in VBA just started it can you implement that in the following sheet Please. https://www.dropbox.com/s/z6lga80zz7blutl/Pivot1.xlsm?dl=0 — AriKari, Aug 30 '15 at 12:35
@Santosh Then read up on VBA. I strongly suggest you start by reading the wikis for [tag:vba], [tag:excel], and [tag:excel-vba], and follow through on the various links. — Zev Spitz, Aug 30 '15 at 15:16
@Santosh If you can only take the time for one link, [this](https://msdn.microsoft.com/en-us/library/ee814735.aspx) should be it, — Zev Spitz, Aug 30 '15 at 15:20

Excel Hero · Accepted Answer · 2015-08-30T21:41:23.117

Make sure that the columns to the right of your source data are blank. The output is going to go there.

Place this routine in a standard code module and run it:

Public Sub CullDistinct()
    Dim rSrc As Range, lRws&, lCls&, lOut&, sOut$, sMn1$, sRow1$
    Set rSrc = [a1].CurrentRegion
    sRow1 = rSrc.Resize(1).Address(0, 1)
    lRws = rSrc.Rows.Count
    lCls = rSrc.Columns.Count
    lOut = lCls + 2
    sOut = Split(Cells(, lOut).Address, "$")(1)
    sMn1 = Split(Cells(, lOut - 1).Address, "$")(1) & 1: sMn1 = sMn1 & ":" & sMn1
    With Range(sOut & 1)
        .FormulaArray = "=IFERROR(INDEX(" & sRow1 & ",MATCH(,COUNTIF($" & sMn1 & "," & sRow1 & "),)),"""")"
        .Copy .Offset(, 1).Resize(, lCls - 1)
        .Resize(, lCls).Copy .Offset(1).Resize(lRws - 1)
        With .Resize(lRws, lCls): .Value = .Value: End With
    End With
End Sub

Delete duplicate entries in a given row

2 Answers2

Linked