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

[Hooseria]

Domski

My appologies, I've gathered that this link will not work, you'll get a PHP download, tell you what, forget it, I'm sure you've got other important stuff to do, this is not urgent or important.

Well thanks for the attention, Cheers.

 

[Nilotna]

I now, it's too long but I'm starting
You can call this procedure from the WorkSheet_Activate and Worksheet_SelectionChange
*****************************
Public Sub Colorear()
Dim WB As Workbook
Dim Sh As Object
Dim RngColores As Range
Dim RngColor As Range
Dim RngFrases As Range
Dim RngCelda As Range
Dim rngAsignacion As Range
Dim DoFilaFrase As Double
Dim DoFilaColor As Double
Dim DoFinalRow As Double
Dim StPalabra As String
Dim StFrase As String
Dim InContador As Integer
Dim InCaracter As Integer
Dim InLongitud As Integer
Dim Asci As Integer
Set WB = ThisWorkbook
Set Sh = WB.Sheets("Sheet1")
'Determina el rango de Frases
DoFinalRow = Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row
Set RngFrases = Range(Sh.Cells(2, 1), Sh.Cells(DoFinalRow, 1))
Set rngAsignacion = Range(Sh.Cells(2, 2), Sh.Cells(DoFinalRow, 2))
rngAsignacion.Clear
'Determina el rango de Colores
DoFinalRow = Sh.Cells(Sh.Rows.Count, 4).End(xlUp).Row
Set RngColores = Sh.Range(Sh.Cells(2, 4), Sh.Cells(DoFinalRow, 4))
'Para cada frase
For Each RngCelda In RngFrases
DoFilaFrase = RngCelda.Row 'Anota la fila de la frase
StFrase = StreenCleaner(RngCelda.Value)
'Busca un espacio
InLongitud = Len(StFrase)
For InContador = 1 To InLongitud + 1
StCaracter = Mid(StFrase, InContador, 1)
If StCaracter = " " Or InContador > InLongitud Then
'Busca un nombre de color
Set RngColor = RngColores.Find(What:=StPalabra, LookIn:=xlValues, lookat:= _
xlWhole, searchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False)
If Not RngColor Is Nothing Then 'Es un color
DoFilaColor = RngColor.Row 'Anota la fila del color
'Escribe en la fila de la frase la segunda columna del color
rngAsignacion(DoFilaFrase - 1, 1) = RngColores(DoFilaColor - 1, 2)
Else
StPalabra = ""
End If 'No es un color
Else
StPalabra = StPalabra & StCaracter
End If
Next InContador
StPalabra = ""
Next RngCelda
End Sub

Public Function StreenCleaner(Cadena As String)
Dim Contador As Integer
Dim Caracter As String
Dim CadenaLimpia As String
Dim Prueba As Integer
For Contador = 1 To Len(Cadena)
Caracter = Mid(Cadena, Contador, 1)
On Error GoTo ErrXEsp
If Asc(Caracter) > 128 Then Caracter = " "
Prueba = Asc(Caracter)
On Error GoTo 0
CadenaLimpia = CadenaLimpia & Caracter
Next
StreenCleaner = Trim(CadenaLimpia)
Exit Function
ErrXEsp:
Caracter = " "
Resume Next
End Function

 

[basudip]

Hello

I see this site today. So its bit late (1 year i think)but I wrote a Macro to solve this. I dont know much about excel, Still learning. So can any body tell me is that my code is grown up or still childish

*******************
Sub test()
i = 1
Range("A2").Select
While ActiveCell.Value <> ""
a = ActiveCell.Value
b = Range("D2:E10").Value

If InStr(a, b(i, 1)) <> 0 Then
rw = ActiveCell.Row

Range("B" & rw).Value = b(i, 2)
i = 0
ActiveCell.Offset(1, 0).Select
End If
i = i + 1
Wend
End Sub

**********

Why Mr Excel not post anymore challange?? What happened to this site??

 

[maheshmaxi]

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)

This is an excellent formula... Great Barry It helps me a lot...

 

[strive4peace]

Public Function VLookup_InAString( _
   pString As String _
   , pLookupTable As Range) As String

   ' written by Crystal
   ' strive4peace2009 at yahoo.com
   ' 6 July 09
   
   ' FIND a keyword in a string
   ' RETURN the value in the cell one column to the right
   
   'PARAMETERS
   ' pString is the value you are searching to find a keyword
   ' pLookupTable is the range of the Lookup Table
   '    assumptions
   '      1st column contains the keyword
   '      2nd column contains the value to return

   'EXAMPLE USEAGE
   ' cell formula --> =VLookup_InAString(A2, $D$2:$E$10)
    
   On Error GoTo Proc_Err
   
   Dim lngRow As Long _
      , arrValues() As String _
      , i As Integer
      
   ' replace no-break space with space
   pString = Replace(pString, Chr(160), " ")
   
   ' split passed string into an array using space as delimiter
   arrValues = Split(pString, " ")
      
   'test each word
   For i = LBound(arrValues) To UBound(arrValues)
   
      'compare the test word with each Keyword
      For lngRow = 0 To pLookupTable.Rows.Count - 1
      
         If Trim(UCase(arrValues(i))) = _
            Trim(UCase(pLookupTable.Offset(lngRow, 0).Resize(1, 1).Value)) Then
         
            'match was found -- return value in the second column of LookupTable
            VLookup_InAString = pLookupTable.Offset(lngRow, 1).Resize(1, 1).Value
            Exit Function
            
         End If
      Next lngRow

   Next i
   
   'comment this statement if you want the value to be blank
   VLookup_InAString = "NOT ASSIGNED"
 
Proc_Exit:
   Exit Function
  
Proc_Err:
   MsgBox Err.Description, , _
        "ERROR " & Err.Number _
        & "   VLookup_InAString"

   Resume Proc_Exit
   Resume
End Function

 

[Qete_ARG]

Barry Houdini...that was quick and impressive!
I didn´t read ALL the solutions, so I hope my UDF is not already posted by another user:

Function AssignNameAccordingToColor(rngPhrase As Range, rngLookupTable As Range) As String
Dim i As Integer
Dim boolFound As Boolean
Dim FoundColor As String

boolFound = False

For i = 1 To rngLookupTable.Rows.Count
 If InStrRev(rngPhrase.Value, rngLookupTable.Cells(i, 1).Value) <> 0 Then
  FoundColor = rngLookupTable.Cells(i, 1).Value
  boolFound = True
  GoTo ColorFound
 End If
Next i
AssignNameAccordingToColor = "No matches"
Exit Function

ColorFound:
AssignNameAccordingToColor = Application.WorksheetFunction.VLookup(FoundColor, rngLookupTable, 2, 0)

End Function

 

[mhalver]

Only just noticed after writing this up that this is an old challenge from last year (I noticed the deadline date but not the year when writing this), but wanted to post my solution anyways - maybe somebody will find it interesting, or somebody can learn something from it (possibly me from comments made on it). This particular formula doesn't seem to have been posted, but some using the same concepts have.

Here is my solution:

Enter this formula into cell B2 as an array formula (Ctrl-Shift-Enter):

=IF(COUNTA(D:D)-1>1,OFFSET($D$2,MATCH(FALSE,ISERROR(FIND(OFFSET($D$2,0,0,COUNTA(D:D)-1,1),A2)),0)-1,1),IF(ISERROR(FIND($D$2,A2)),"",$E$2))​

The formula first looks to see how many entries are present in column D. If there is only 1, it uses the formula

=IF(ISERROR(FIND($D$2,A2)),"",$E$2)

If there are more than 1, it uses

=OFFSET($D$2,MATCH(FALSE,ISERROR(FIND(OFFSET($D$2,0,0,COUNTA(D:D)-1,1),A2)),0)-1,1)

The second formula checks each color and sees if it is not in the phrase, returning an array of trues and falses. It then finds the first false (the first color in the phrase), and finds the name corresponding to this. The first formula works the same way, but only with the single entry. If we know that there are multiple entries, we can just use the second formula (this one will fail if there is only a single entry).

The formula works, without modification, for any number of entries in the DE table (except 0) - I omitted the 0 case, as if we are attempting to solve this problem, we can assume that there must be some data. Some modification can be made if we must consider this case.

 

[iluxo]

I have this solutions:

=VLOOKUP(INDEX($D$2:$D$10,INDEX(MATCH(9999,SEARCH($D$2:$D$10,J4)),1)),$D$2:$E$10,2)

=VLOOKUP(INDEX($D$2:$D$10,MATCH(9999,SEARCH($D$2:$D$10,A2))),$D$2:$E$10,2)

number 9999 is only a "big" number, hoping the search list is not big enough, but it can be replaced with another really big.

 

[iluxo]

Ooops..
I forgot the false condition

=VLOOKUP(INDEX($D$2:$D$10,INDEX(MATCH(9999,SEARCH($D$2:$D$10,J4)),1)),$D$2:$E$10,2,false)

=VLOOKUP(INDEX($D$2:$D$10,MATCH(9999,SEARCH($D$2:$D$10,A2))),$D$2:$E$10,2,false)

thanks.

 

[Phamacom80]

Hi Everyone,

I'm new to this forum and would like to understand what exactly does this formula do in solving the monthly challenge.

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

I understand what the Lookup function does and I understand what the Search function. The search function if entered alone will provide an error of #VALUE. Also, why are we are looking up 2 to 15th power. I'm absolutely confuse.

Thanks.