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

[Oorang]

Re: June/July 2008 Challenge of the Month

Here's one possibility.....

=LOOKUP(2^15,SEARCH(D$2:D$10,A2),E$2:E$10)

Slick

 

[Oaktree]

Re: June/July 2008 Challenge of the Month

Bill,

How should this be mapped?

I borrowed my friend Red's blue and white shirt.

 

[Lewiy]

Re: June/July 2008 Challenge of the Month

Here’s another UDF option:
<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o> </o>

Function ColorString(icolors As Range, istring As Range)<o:p></o:p>
Dim r As Range<o:p></o:p>
For Each r In icolors<o:p></o:p>
    If InStr(istring, r) > 0 And r.Value <> "" Then<o:p></o:p>
        ColorString = r.Value<o:p></o:p>
    End If<o:p></o:p>
Next r<o:p></o:p>
End Function

<o> </o>
=colorstring($D$2:$D$13,A2)

 

[cornflakegirl]

Re: June/July 2008 Challenge of the Month

Lewiy - that returns the colour, rather than the person it's assigned to...
(Also can't handle redditch).

 

[Jonmo1]

Re: June/July 2008 Challenge of the Month

OK, here's a slight improvement on my UDF. Doing the Replace Chr(160) before the Loop (instead of once for each loop), so it only has to do it once...Slight performance improvement..
Plus removed a couple unneeded pieces of code..

Although I don't see anything (code or formula) being any cooler than Barry's Formula. That was just Sick!!

Public Function Jonmo1(C As Range, L As Range) As String
Dim MyArray As Variant
Dim X As Long, Y
MyArray = Split(Replace(C, Chr(160), ""))
For X = LBound(MyArray) To UBound(MyArray)
    Y = Application.Match(MyArray(X), L.Columns(1), 0)
    If Not IsError(Y) Then
        Jonmo1 = L(Y, 2)
        Exit For
    End If
Next X
End Function

 

[Jonmo1]

Re: June/July 2008 Challenge of the Month

And now, to go into OverKill Mode. I don't think anyone has accounted for a possibility of having more than one color in the sentence... "My red car's exhaust is blue."

This now has an optional argument for the Nth Color...
If Nth is Omitted, the First color found in the string is used..
If Nth is Larger than the Number of colors in the string, the Last one is used.
=Jonmo1(A2,D:E,Nth)

Public Function Jonmo1(C As Range, L As Range, Optional Nth As Long = 1) As String
Dim MyArray As Variant
Dim Counter As Long, X As Long, Y
MyArray = Split(Replace(C, Chr(160), ""))
For X = LBound(MyArray) To UBound(MyArray)
    Y = Application.Match(MyArray(X), L.Columns(1), 0)
    If Not IsError(Y) Then
        Counter = Counter + 1
        Jonmo1 = L(Y, 2)
        If Counter = Nth Then
            Exit For
        End If
    End If
Next X
End Function

 

[pepijn]

Re: June/July 2008 Challenge of the Month

Here is an other matrix funtion

=INDEX($E$2:$E$10,MATCH(1,IF(SEARCH($D$2:$D$10,A2)>0,1,0),0))

confirm with ctrl + shift + enter

 

[Jonmo1]

Re: June/July 2008 Challenge of the Month

OK, now I'm really going off the deep end. Somebody stop me...

I've seen comments about how the string may contain a word like redditch (is that actually a word?). I think it was generally assumed that that word would NOT want to be found... But I figured, why not make it an option...

Options Options, I love options...

Now you have 2 optional arguments...
1st for the Nth Color to find.
2nd for Exact Match or Fuzzy Match..

4th argument (Fuzzy)
Omitted = False
False = Findes an EXACT match, i.e. will not find redditch
True = Finds a FUZZY match, i.e. it WILL find redditch

I also added code to use only the actual used range, so if you use an entire column ref, it will only utilize the Used Range..

=Jonmo1(A1,D:E,Nth,True/False)

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
            Jonmo1 = MyRange(Y, 2)
            If counter = Nth Then Exit For
        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 Nth = UBound(Pos)
    X = Application.Small(Pos, Nth)
    Jonmo1 = Application.VLookup(Word(Application.Match(X, Pos, 0)), MyRange, 2, 0)
End If
End Function

OK, that should really be enough......LOL...

 

[Patience]

Re: June/July 2008 Challenge of the Month

redditch (is that actually a word?).

Finally I can contribute! Yes, Redditch is a place in England.

 

[Jonmo1]

Re: June/July 2008 Challenge of the Month

Finally I can contribute! Yes, Redditch is a place in England.

Thank you, I thought I was going nutz...