***WINNERS ANNOUNCEMENT*** June/July 2008 Challenge of the Month

Public Function Jonmo1(C As Range, L As Range, Optional Nth As Long = 1, _
Optional Fuzzy As Boolean = False) As String
Dim MyArray As Variant
Dim Pos() As Variant
Dim Word() As Variant
Dim MyRange As Range
Dim r As Range
Dim counter As Long, X As Long, Y
Set MyRange = Range(L(1, 1), L(L.Rows.Count, 1).End(xlUp).Offset(0, L.Columns.Count - 1))
If Fuzzy = False Then
    MyArray = Split(Replace(C, Chr(160), ""))
    For X = LBound(MyArray) To UBound(MyArray)
        Y = Application.Match(MyArray(X), MyRange.Columns(1), 0)
        If Not IsError(Y) Then
            counter = counter + 1
            If counter = Nth Then
                Jonmo1 = MyRange(Y, 2)
                Exit For
            End If
        End If
    Next X
Else
    For Each r In Range(MyRange.Columns(1).Address)
        X = InStr(1, C, r)
        If X > 0 Then
            counter = counter + 1
            ReDim Preserve Pos(1 To counter)
            ReDim Preserve Word(1 To counter)
            Pos(counter) = X
            Word(counter) = r
        End If
    Next r
    If counter < 1 Then Exit Function
    If Nth > UBound(Pos) Then Exit Function
    X = Application.Small(Pos, Nth)
    Jonmo1 = Application.VLookup(Word(Application.Match(X, Pos, 0)), MyRange, 2, 0)
End If
End Function

Function MatchColors(strValue As String, rngList As Range) As String
    Dim regEx, Matches, i, strResult, bFlag
    
    'Create and set the parameters for the regular expressions object
    Set regEx = CreateObject("vbscript.regexp")
    regEx.Global = True
    regEx.IgnoreCase = True
    
    For i = 1 To rngList.Rows.Count
        'Just in case someone uses full column ranges
        If rngList.Cells(i, 1).Value = "" Then Exit For
        'Wrap the values on \b to mark word boundaries
        regEx.Pattern = "\b" & rngList.Cells(i, 1).Value & "\b"
        Set Matches = regEx.Execute(strValue)
        'If there is a match, add the relevant name to the string
        If Matches.Count > 0 Then
            'If that is not the first match, include a word separator
            If bFlag Then strResult = strResult & ", "
            strResult = strResult & rngList.Cells(i, 2).Value
            bFlag = 1
        End If
    Next
    MatchColors = strResult
End Function