Anonymous Anonymous - 3 days ago
36 0

Return concatenated match values in single cell

Vb.net

Custom UDF

Public Function GetResults(ByVal searchString As String, ByVal searchRange As Range, ByVal returnRange As Range) As String

    Dim returnValue As String
    
    If searchRange.Rows.Count > ActiveSheet.UsedRange.Rows.Count Then
        Set searchRange = Intersect(searchRange, ActiveSheet.UsedRange)
    End If
    
    If returnRange.Rows.Count > ActiveSheet.UsedRange.Rows.Count Then
        Set returnRange = Intersect(returnRange, ActiveSheet.UsedRange)
    End If
    
    If Not searchRange.Rows.Count = returnRange.Rows.Count Then
        returnValue = "Error: Search/Return areas are different size"
        GoTo EarlyExit:
    End If
    
    If searchRange.Columns.Count > 1 Or returnRange.Columns.Count > 1 Then
        returnValue = "Error: Search/Return areas cannot be wider than 1 column"
        GoTo EarlyExit:
    End If
    
    For i = 1 To searchRange.Cells.Count
        If searchRange.Cells(i).Value = searchString Then
            returnValue = returnValue & " \ " & returnRange.Cells(i).Value
        End If
    Next
    
    If Len(returnValue) > 1 Then
        returnValue = Right$(returnValue, Len(returnValue) - 3)
    End If
        
EarlyExit:
    GetResults = returnValue
    
End Function
Comments