Excel BVA

gistfile1.txt

Option Explicit
       
        

Function LookupCSVResults(lookupValue As Variant, lookupRange As Range, resultsRange As Range) As String
    
    Dim s As String 'Results placeholder
    Dim sTmp As String  'Cell value placeholder
    Dim sTmpOffset As Range  'Cell value placeholder
    Dim r As Long   'Row
    Dim c As Long   'Column
    Const strDelimiter = "|||"  'Makes InStr more robust
    Dim Out As String
    s = strDelimiter
    
    For r = 1 To lookupRange.Rows.Count
        If InStr(LCase(lookupRange.Cells(r, 1).Value), LCase(lookupValue.Cells(1, 1).Value)) <> 0 Then
            sTmp = resultsRange.Offset(r - 1, 0).Cells(1, 1).MergeArea(1, 1).Value
            If InStr(1, s, strDelimiter & sTmp & strDelimiter) = 0 Then
                s = s & sTmp & strDelimiter
            End If
        End If
     Next
    
    'Now make it look like CSV
    s = Replace(s, strDelimiter, ", ")
    If Left(s, 1) = ", " Then s = Mid(s, 2)
    If Right(s, 1) = ", " Then s = Left(s, Len(s) - 1)
    LookupCSVResults = s 'Return the function
    
End Function

Function ComplexCSVResults(lookupValues As Range, lookupRange As Range, resultsRange As Range) As String
    
    Dim sDivision As String 'Results placeholder
    Dim sBusinessUnit As String 'Results placeholder
    Dim sTeam As String 'Results placeholder
    Dim sSubTeam As String 'Results placeholder
    Dim sPositionName As String 'Results placeholder
    Dim sSearchPosName As String
    ' Dim lookupValue As String
    Dim s As String 'Results placeholder
    Dim sTmp As String  'Cell value placeholder
    Dim r As Long   'Row
    Dim c As Long   'Column
    Const strDelimiter = "|||"  'Makes InStr more robust
    
   ' s = strDelimiter
    
   ' lookupValue = lookupRange.Cells(1, 1).Value
           
    sDivision = lookupValues.Cells(1, 2).Value
    sBusinessUnit = lookupValues.Cells(1, 3).Value
    sTeam = lookupValues.Cells(1, 4).Value
    sSubTeam = lookupValues.Cells(1, 5).Value
    sPositionName = lookupValues.Cells(1, 1).Value
    
    If sDivision = "" And sBusinessUnit = "" And sTeam = "" And sSubTeam = "" And sPositionName = "" Then
        ' Everyone gets this role.
        For r = 1 To lookupRange.Rows.Count
            sTmp = resultsRange.Offset(r - 1, c).Cells(1, 1).Value
            If InStr(1, s, strDelimiter & sTmp & strDelimiter) = 0 Then
                s = s & sTmp & strDelimiter
            End If
        Next
        Else
        For r = 1 To lookupRange.Rows.Count
            sSearchPosName = lookupRange.Cells(r, 5).Value
            
            If lookupRange.Cells(r, 1).Value = sDivision Then
                If sBusinessUnit = "" And sTeam = "" And sSubTeam = "" Then
                    ' Only the Division has value
                    If sPositionName = "" Or sPositionName = sSearchPosName Then
                        sTmp = resultsRange.Offset(r - 1, c).Cells(1, 1).Value
                        If InStr(1, s, strDelimiter & sTmp & strDelimiter) = 0 Then
                            s = s & sTmp & strDelimiter
                        End If
                    End If
                End If
                If lookupRange.Cells(r, 2).Value = sBusinessUnit Then
                   If sTeam = "" And sSubTeam = "" Then
                        ' Only the Division and BU have values
                        If sPositionName = "" Or sSearchPosName = sPositionName Then
                            sTmp = resultsRange.Offset(r - 1, c).Cells(1, 1).Value
                            If InStr(1, s, strDelimiter & sTmp & strDelimiter) = 0 Then
                                s = s & sTmp & strDelimiter
                            End If
                        End If
                    End If
                    If lookupRange.Cells(r, 3).Value = sTeam Then
                        If sSubTeam = "" Then
                        ' Only the Team has a values
                            If sPositionName = "" Or sSearchPosName = sPositionName Then
                                sTmp = resultsRange.Offset(r - 1, c).Cells(1, 1).Value
                                If InStr(1, s, strDelimiter & sTmp & strDelimiter) = 0 Then
                                    s = s & sTmp & strDelimiter
                                End If
                            End If
                        End If
                        If lookupRange.Cells(r, 4).Value = sSubTeam Then
                            If sPositionName = "" Or sSearchPosName = sPositionName Then
                                sTmp = resultsRange.Offset(r - 1, c).Cells(1, 1).Value
                                If InStr(1, s, strDelimiter & sTmp & strDelimiter) = 0 Then
                                    s = s & sTmp & strDelimiter
                                End If
                            End If
                        End If
                    End If
                End If
            End If
     ' End If
        Next
    End If
        
'Now make it look like CSV
's = Replace(s, strDelimiter, Chr(10))
    
    s = Replace(s, strDelimiter, "; ")
    If Left(s, 1) = "; " Then s = Mid(s, 2)
    If Right(s, 1) = "; " Then s = Left(s, Len(s) - 1)
    
    ComplexCSVResults = s 'Return the function
    
End Function