Identifying the Unique values in Rows

[Rajesh S]

Dear Team,

Please refer the attached sample file. Need the result as given in the Column P.

Tried multiple ways but could not succeed. Can anyone help me with this formula?

Thanks

Regards

S Rajesh

 

[Rajesh S]

Hi Marc,
Advanced filter cannot be used here as I have 1.5 L records where this exercise to be performed.

Regards

S Rajesh

 

[Ashhu]

Rajesh,
Attached sheet has formula in cell (Q:X)which will extract unique values.
Concatenation in P col is not done yet, need change. as i am leaving now i can check tonight or tomrrow.
as you are saying entries are more than 1 lac and formula is Array, it will consume considerable amount of time to execute.
PS: Formula taken from other site. Not mine.

 

[Rajesh S]

Thanks Ashhu. This should help. Will apply this formula across & revert if need be.. Thanks for your immediate response.

 

[Marc L]

Hi !​

Hi Marc,
Advanced filter cannot be used here as I have 1.5 L records where this exercise to be performed.

When I saw your attachment, I knew it wasn't possible with a filter …
I deleted my post 'cause I thought you hadn't time to read it …

I can provide you a personal function via VBA but called in a cell formula
or just a VBA procedure called by a button or manually
(both no need some helper column) …
​

 

[Nebu]

Hi:

There are lot of ready made functions available on web, here is one from @jindon

Function ConcatUniq(ByRef rng As Range, _
    ByVal myJoin As String, Optional ord As Boolean = True) As String
    Dim r As Range
    With CreateObject("System.Collections.ArrayList")
        For Each r In rng
            If Not .Contains(CStr(r.Value)) Then .Add CStr(r.Value)
        Next
        .Sort
        If Not ord Then .Reverse
        ConcatUniq = Join$(.ToArray, myJoin)
    End With
End Function

http://www.ozgrid.com/forum/showthread.php?t=160873&page=2
Thanks

 

[jindon]

It requires some modification to satisfy op's requirement.

Function ConcatUniq(ByRef rng As Range, _
    ByVal myJoin As String, Optional ord As Boolean = True) As String
    Dim r As Range
    With CreateObject("System.Collections.ArrayList")
        For Each r In rng
            If (r<>"") * (r<>0) * (Not .Contains(CStr(r.Value))) Then .Add CStr(r.Value)
        Next
        .Sort
        If Not ord Then .Reverse
        ConcatUniq = Join$(.ToArray, myJoin)
    End With
End Function

However, for this case, the following would be better...
=ConcatUniq(C3:O3,", ")

Function ConcatUniq(ByVal rng As Range, ByVal myJoin As String) As String
    Dim r As Range
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For Each r In rng
            If (r <> "") * (r <> 0) * (Not .exists(r.Value)) Then .Item(r.Value) = Empty
        Next
        ConcatUniq = Join(.keys, myJoin)
    End With
End Function

 

[jindon]

Just to clean the line.

Function ConcatUniq(ByVal rng As Range, ByVal myJoin AsString) As String
   Dim r As Range
   With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
       For Each r In rng
           If (r <> "") * (r <> 0)  Then .Item(r.Value) = Empty
       Next
        ConcatUniq = Join(.keys, myJoin)
   End With
End Function

 

[Marc L]

Rajesh, to test a personal function you must first create in VBE
a standard module then paste to it function code …

Formula to enter in P3 cell : =RowUnique(C3:O3)
Copy down …

As they are very few cells by row, with only Excel basics
no external Windows object so works too on MAC :​

Function RowUnique$(Rg As Range)
        VA = Filter(Evaluate(Replace("IF(#<>0,#)", "#", Rg.Rows(1).Address)), False, False)
        If UBound(VA) < 0 Then Exit Function
        S$ = VA(0)
        VA = Filter(VA, VA(0), False)
    Do Until UBound(VA) < 0
         S = S & ", " & VA(0)
        VA = Filter(VA, VA(0), False)
    Loop
         RowUnique = S
End Function

Or​

Function RowUnique$(Rg As Range)
        VA = Filter(Evaluate(Replace("IF(#<>0,#)", "#", Rg.Rows(1).Address)), False, False)
        If UBound(VA) < 0 Then Exit Function
        ReDim RU$(1 To UBound(VA) + 1)
    For Each V In VA
        If IsError(Application.Match(V, RU, 0)) Then N% = N% + 1: RU(N) = V
    Next
         ReDim Preserve RU(1 To N)
         RowUnique = Join(RU, ", ")
End Function

Do you like it ? So thanks to click on bottom right Like !
​

 

[Rajesh S]

Thanks Marc. This code had done magic. Fast & able to complete the 1.5L lines in 2 mins. Awesome

 

[Rajesh S]

Thanks for your support Jindon. Had got some coding error, hence used Marc's file

 

[jindon]

Thanks for your support Jindon. Had got some coding error, hence used Marc's file

 

[Marc L]

Fast & able to complete the 1.5L lines in 2 mins.

Without a function but with a global procedure using jindon's way
(Dictionary object) and an array variable may be the fastest …

Try this third function using an inner Collection (like a Dictionary) :​

Function RowUnique$(Rg As Range)
         Dim oRow As New Collection, N%, S$, V, VA
         VA = Filter(Evaluate(Replace("IF(#<>0,#)", "#", Rg.Rows(1).Address)), False, False)
         If UBound(VA) < 0 Then Exit Function
         On Error Resume Next
         For Each V In VA:  oRow.Add V, V:  Next
         On Error GoTo 0
         S = oRow(1)
         For N = 2 To oRow.Count:  S = S & ", " & oRow(N):  Next
         RowUnique = S
End Function

You may Like it …
​

 

[jindon]

If Evaluate method, one line should be enough...

Function ConcatUniq(ByVal rng As Range, ByVal myJoin As String) As String
    ConcatUniq = Join(Filter(rng.Parent.Evaluate("if((" & rng.Address & "<>0)*(countif(offset(" & rng.Address & ",,,,column(" & _
    [a1].Resize(, rng.Columns.Count).Address & "))," & rng.Address & ")=1)," & rng.Address & ",char(2))"), Chr(2), 0), myJoin)
End Function

 

[Rajesh S]

A BIG thanks to both of you - Marc & Jindon.

Hats of to your knowledge on coding!! Simply great