Modifying a UDF Concatenate to Remove Duplicates

Question

I've got a custom vlookup that I'd like to modify to remove duplicates before concatenation. This is the data I've got put together. I'm taking the feature names from Column A and removing duplicates to create unique data to use the custom Vlookup on in the F column.

In the F column, I am using this Excel Function: {=IFERROR(INDEX(A$2:A$12,MATCH(0,COUNTIF(F$1:F2,A$2:A$12),0)),"")}

From here I am using a UDF that selects the code to the left of it, then searches through the table to find feature names that match, then extracting the location codes to be put into a concatenate that spaces out the names. This is what I have in VBA for a module.

`Function CusVlookup(FeatureName As String, pWorkRng As Range, pIndex As Long)
  Dim rng As Range
   Dim xResult As String
    xResult = ""
    For Each rng In pWorkRng
     If rng = FeatureName Then
     xResult = xResult & ", " & rng.Offset(0, pIndex - 1)
      If Left(xResult, 2) = ", " Then
      xResult = Mid(xResult, 2, 255)
   End If
  End If
  Next
  CusVlookup = xResult
  End Function`

The function used in cell G3 is as follows: =cusvlookup(F3,A2:E12,5)

This is my first real foray into VBA, and the code I have was what I could find sifting through google searches and on here. All I need this code to do is to remove duplicate values before concatenation, but an explanation of what is happening would be appreciated.

Answer 1

Just a little change in your function. Note the Range below is A2:A14 (not like A2:E12 in your code). .. For INSTR VBA Function Check this link

Function CusVlookup(FeatureName As String, pWorkRng As Range, pIndex As Long)
Dim rng As Range
Dim xResult As String
xResult = ""

For Each rng In pWorkRng
    If rng = FeatureName And InStr(1, xResult, rng.Offset(0, pIndex - 1) & ",") = 0 Then
        If xResult = "" Then
        xResult = rng.Offset(0, pIndex - 1) & ", "
        Else
        xResult = xResult & rng.Offset(0, pIndex - 1) & ", "
        End If
    End If
Next

CusVlookup = Mid(xResult, 1, Len(xResult) - 2)
End Function

You can Step into following procedure (debug using F8 Key) to understand what is happening in your function.

Sub test()
Dim FeatureName As String: FeatureName = Range("F3").Value
Dim pWorkRng As Range: Set pWorkRng = Range("A2:A12")
Dim pIndex As Long: pIndex = 5

Dim rng As Range
Dim xResult As String
xResult = ""

For Each rng In pWorkRng
    If rng = FeatureName And InStr(1, xResult, rng.Offset(0, pIndex - 1) & ",") = 0 Then
        If xResult = "" Then
        xResult = rng.Offset(0, pIndex - 1) & ", "
        Else
        xResult = xResult & rng.Offset(0, pIndex - 1) & ", "
        End If
    End If
Next

Debug.Print Mid(xResult, 1, Len(xResult) - 2)

End Sub