UDF to lookup and return multiple values concatenated into one cell without duplicates

[rhaas128]

I am looking at a few thousand rows and need to locate the matches, remove duplicates for each, and concatenate the remaining values into a single cell with a delimiter. Example:


The server list column should be compared against another sheet that contains a list of server names and owners. If multiple matching server names are found, the owners in the owner name column should be concatenated with a comma and put into the owner list.

If a a server name and owner are duplicates, they should be ignored.

So below, Server01p01 is listed 3 times, twice with UserA, and once with UserB as the owner. The second UserA should be ignored as it has a matching pair already, and only UserA and UserB should be added to the owner list.



[TABLE="width: 500"]
<tbody>[TR]
[TD]Server List[/TD]
[TD]Owner List[/TD]
[/TR]
[TR]
[TD]Server01p01[/TD]
[TD]UserA, UserB[/TD]
[/TR]
[TR]
[TD]Server2[/TD]
[TD]UserB[/TD]
[/TR]
[TR]
[TD]Server94_S02[/TD]
[TD]UserA[/TD]
[/TR]
</tbody>[/TABLE]



[TABLE="width: 500"]
<tbody>[TR]
[TD]Server Name[/TD]
[TD]Owner Name[/TD]
[/TR]
[TR]
[TD]Server01p01[/TD]
[TD]UserA[/TD]
[/TR]
[TR]
[TD]Server2[/TD]
[TD]UserB[/TD]
[/TR]
[TR]
[TD]Server01p01[/TD]
[TD]UserB[/TD]
[/TR]
[TR]
[TD]Server94_S02[/TD]
[TD]UserA[/TD]
[/TR]
[TR]
[TD]Server01p01[/TD]
[TD]UserA[/TD]
[/TR]
</tbody>[/TABLE]

Any and all help is greatly appreciated. Thanks in advance!

 

[Fluff]

How about

Function rhaas(rng As Range, Srvr As String) As String
   Dim Cl As Range
   For Each Cl In rng
      If Cl.Value = Srvr Then
         If InStr(1, rhaas, Cl.Offset(, 1).Value, vbTextCompare) = 0 Then
            rhaas = rhaas & Cl.Offset(, 1).Value & ", "
         End If
      End If
   Next Cl
   rhaas = Left(rhaas, Len(rhaas) - 2)
End Function

Used like
=rhaas(Sheet1!$A$2:$A$6,A2)

 

[rhaas128]

How about

Function rhaas(rng As Range, Srvr As String) As String
   Dim Cl As Range
   For Each Cl In rng
      If Cl.Value = Srvr Then
         If InStr(1, rhaas, Cl.Offset(, 1).Value, vbTextCompare) = 0 Then
            rhaas = rhaas & Cl.Offset(, 1).Value & ", "
         End If
      End If
   Next Cl
   rhaas = Left(rhaas, Len(rhaas) - 2)
End Function

Used like
=rhaas(Sheet1!$A$2:$A$6,A2)

I'm getting a #VALUE ! error. Any thoughts on why without seeing the sheet?

Some server names in the list contain a .domainname.com. And most owners have spaces in the names. Could that be causing the issue?

 

[Fluff]

That error suggest that the server name in A2 is not in the list of servers on the other sheet.

 

[rhaas128]

Hrmm.. it is on the other sheet, but the case does not match. I thought vbtextcompare didn't care about case. Am I missing something? If I match the case, results return just fine. I also made sure I didn't just copy/paste the lookup value in case there were spaces or anything odd.

 

[Fluff]

If the case is different try

Function rhaas(rng As Range, Srvr As String) As String
   Dim Cl As Range
   For Each Cl In rng
      If[COLOR=#ff0000] LCase(Cl.Value) = LCase(Srvr)[/COLOR] Then
         If InStr(1, rhaas, Cl.Offset(, 1).Value, vbTextCompare) = 0 Then
            rhaas = rhaas & Cl.Offset(, 1).Value & ", "
         End If
      End If
   Next Cl
   rhaas = Left(rhaas, Len(rhaas) - 2)
End Function

 

[rhaas128]

Perfect. Thanks a bunch!

 

[Fluff]

You're welcome & thanks for the feedback

 

[rhaas128]

I know this thread is considered resolved, but I have an additional question. The sheet I have been running this code in has grown to a couple thousand rows. With this code, I am experiencing a significant performance issue and it takes several minutes for the code to run, and every time I attempt to do something else, the sheet re-processes.

Is there a way to better optimize this with the amount of data I am looking through?

 

[Fluff]

How about

Function rhaas(rng As Range, Srvr As String) As String
   Dim ary As Variant
   Dim i As Long
   ary = rng.Value
   For i = 1 To UBound(ary)
      If LCase(ary(i, 1)) = LCase(Srvr) Then
         If InStr(1, rhaas, ary(i, 2), vbTextCompare) = 0 Then
            rhaas = rhaas & ary(i, 2) & ", "
         End If
      End If
   Next i
   rhaas = Left(rhaas, Len(rhaas) - 2)
End Function

Used like
=rhaas(Sheet3!$A$2:$B$8826,A2)