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

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
Re: June/July 2008 Challenge of the Month

Bill,

How should this be mapped?

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

:devilish: :)
 
Re: June/July 2008 Challenge of the Month

Here’s another UDF option:
<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:eek:ffice:eek:ffice" /><o:p> </o:p>
Rich (BB code):
Rich (BB code):
Rich (BB code):
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:p> </o:p>
=colorstring($D$2:$D$13,A2)
 
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).
 
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!!

Code:
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
 
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)
Code:
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
 
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
 
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)

Code:
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...
 
Last edited:
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...
 

Forum statistics

Threads
1,212,933
Messages
6,110,751
Members
448,295
Latest member
Uzair Tahir Khan

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top