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

[Jonmo1]

Re: June/July 2008 Challenge of the Month

OK, so this is the first Challenge I've participated in. When/How do we know the results?

 

[kevinmintz006]

Re: June/July 2008 Challenge of the Month

-------------------------------------
Sub Solution()
Dim i As Long, strx As String,
i = 2

Columns("A:A").Select
Application.CutCopyMode = False
Selection.Copy
Columns("B:B").Select
ActiveSheet.Paste

intRow = Range("D:D").SpecialCells(xlCellTypeConstants).Count
For i = 1 To intRow
strx = "D" & i

Selection.Replace What:="* " & Range(strx).Value & " *", Replacement:="=E" & i, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Next
End Sub
-------------------------
***Deleted unnecessary code. sticking with copy and paste.

Who likes blue-green anymore? Turqoise is way better. lol. j/k
It would still work as long as the blue-green is closer to the top of the list than the blue or the green. You would just have to impose that restriction on the person typing the list.

Another way to fix this would be to write code to add to the beginning of the macro to first sort the Keywords by character length from longest to shortest before applying the rest (to ensure blue-green shows up first). [Or adding a reverse counter that counts down from the max charater length to the shortest and finding matches from longest to shortest]

But for all intensive purposes, this way is quicker and works perfectly fine as long as you don't have "blue-green."

Thanks for the comments Eugene.

 

[EugeneCarter]

Re: June/July 2008 Challenge of the Month

-------------------------------------
...
...
Columns("A:A").Select
Application.CutCopyMode = False
Selection.Copy
Columns("B:B").Select
ActiveSheet.Paste
...
...
-------------------------
***Deleted unnecessary code. sticking with copy and paste.
...
...

Another way to fix this would be to write code to add to the beginning of the macro to first sort the Keywords by character length from longest to shortest before applying the rest (to ensure blue-green shows up first). [Or adding a reverse counter that counts down from the max charater length to the shortest and finding matches from longest to shortest]

But for all intensive purposes, this way is quicker and works perfectly fine as long as you don't have "blue-green."

Thanks for the comments Eugene.

No Prob. Question though, can't you replace

Columns("A:A").Select
Application.CutCopyMode = False
Selection.Copy
Columns("B:B").Select
ActiveSheet.Paste

with

Columns("B:B").Value = Columns("A:A").Value

?
I like the idea of running from longest to shortest.. that'd fix that blue-green smart guy...

 

[smartchap]

Re: June/July 2008 Challenge of the Month

I have tried it with VB6 and it works fine. Here is a macro for this:

Sub Assign()
For i = 2 To 10
Colorname = Cells(i, "D").Value
Name = Cells(i, "E").Value
For j = 2 To 25
colorexist = InStr(1, Cells(j, "A").Value, Colorname)
If colorexist <> 0 Then
Cells(j, "B").Value = Name & ": " & Cells(j, "A").Value
End If
Next
Next
End Sub

 

[Rhino_Dance]

Re: June/July 2008 Challenge of the Month

Good, solid solution Smartchap. Very direct.

 

[smartchap]

Re: June/July 2008 Challenge of the Month

Thanks Rhino_Dance for the compliments. The code can be generalized if number of rows in any column increases or changes so that number of filled rows in that column is read and used as range. Thanks once again.

 

[smartchap]

Re: June/July 2008 Challenge of the Month

To make it general so that may take care of number of entries in columns A, D & E the modified code is as below:

Sub Assign()
For i = 2 To Range("D2", Range("D2").End(xlDown)).Count + 1
Colorname = Cells(i, "D").Value
Name = Cells(i, "E").Value
For j = 2 To Range("A2", Range("A2").End(xlDown)).Count + 1
colorexist = InStr(1, Cells(j, "A").Value, Colorname)
If colorexist <> 0 Then
Cells(j, "B").Value = Name & ": " & Cells(j, "A").Value
End If
Next
Next
End Sub

+1 is added because data starts from second row in A & D columns.

 

[smartchap]

Re: June/July 2008 Challenge of the Month

Following code will take care of sentences like:
My friend red's shirt is blue
and
the country Redditch in Australia is very beautful

and check the first colour name in the sentence.


Sub Assign()
For i = 2 To Range("D2", Range("D2").End(xlDown)).Count + 1
Colorname = LCase$(Cells(i, "D").Value)
Name = Cells(i, "E").Value
For j = 2 To Range("A2", Range("A2").End(xlDown)).Count + 1
colorexist = InStr(1, LCase$(Cells(j, "A").Value), Colorname)
If colorexist <> 0 Then
Cells(j, "B").Value = Name & ": " & Cells(j, "A").Value
End If
Next
Next
End Sub

 

[smartchap]

Re: June/July 2008 Challenge of the Month

Modified code for checking all color names and assigning them is as follows:

Sub Assign3()
For i = 2 To Range("D2", Range("D2").End(xlDown)).Count + 1
Colorname = LCase$(Cells(i, "D").Value)
Name = Cells(i, "E").Value
For j = 2 To Range("A2", Range("A2").End(xlDown)).Count + 1
colorexist = InStr(1, LCase$(Cells(j, "A").Value), Colorname)
If colorexist <> 0 Then
If Cells(j, "B").Value = "" Then
Cells(j, "B").Value = Name & ": " & Cells(j, "A").Value
Else
Cells(j, "B").Value = Cells(j, "B").Value + Chr(10) + Name & ": " & Cells(j, "A").Value
End If
End If
Next
Next
End Sub

 

[AASkehan]

Re: June/July 2008 Challenge of the Month

I have a simple formula based solution for those not versed in VBA or arrays.

I started by creating a table (F2:N26) to identify which color was in the Phrase by
- Taking the list of colors and transposing them as titles. (F2:N2)
- The used the "find" function to idenitfy the color.
- Then added the ISERROR trap to remove any #value returns.
Example formula to evaluate the phrase in A3 against Blue (F2)
'=IF(ISERROR(FIND(F$2,$A3)),"",F$2)

2nd formula is to place the names in column B
by 'CLEAN' ing the concatenated row of values to obtain just the color, then do a simple VLOOKUP to return the correct name.
<TABLE style="WIDTH: 340pt; BORDER-COLLAPSE: collapse" cellSpacing=0 cellPadding=0 width=452 border=0 x:str><COLGROUP><COL style="WIDTH: 224pt; mso-width-source: userset; mso-width-alt: 12714" width=298><COL style="WIDTH: 41pt; mso-width-source: userset; mso-width-alt: 2304" width=54><COL style="WIDTH: 53pt; mso-width-source: userset; mso-width-alt: 3029" width=71><COL style="WIDTH: 22pt; mso-width-source: userset; mso-width-alt: 1237" width=29><TBODY><TR style="HEIGHT: 12.75pt" height=17><TD class=xl65 style="BORDER-RIGHT: #c0c0c0; BORDER-TOP: #c0c0c0; BORDER-LEFT: #c0c0c0; WIDTH: 340pt; BORDER-BOTTOM: #c0c0c0; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent" width=452 colSpan=4 height=17 x:str="'=VLOOKUP(CLEAN(F3&G3&H3&I3&J3&K3&L3&M3&N3),$C$3:$D$11,2,FALSE)">=VLOOKUP(CLEAN(F3&G3&H3&I3&J3&K3&L3&M3&N3),$C$3:$D$11,2,FALSE)</TD></TR></TBODY></TABLE>
This method allows the rows to be rearranged, but not to have multiple colors in one Phrase.