Hello:

Here's what I'm trying to do:

1.) Create a workbook (WB1) with a list of words in A1 - A50.
2.) Open up another workbook (WB2) that already has existing data. This
workbook gets sent to me everyday with new data.
3.) Run a macro to search and for all words in WB2 that are on the list in
WB1. For each word listed in WB2, I want to change the text of the cell to
red and bold with a thick red border.

Right now I have something that does something like this, but I have the
macro in PERSONAL.XLSB and the list of search strings are hardcoded in the
macro. To make it more user friendly, I'd like to have the search string in
a column so that updates to the strings can be made without modifying the
macro itself.

Please direct me to any sample code to do this. I've been searching but I
don't know the correct terms to search for, so I'm not getting any relevant
results.

Thank you.

--
Regards,
M
MCTS, MCSA

Try this code



VBA Code:
--------------------


Sub ColorCells()

Set Sourcesht = ThisWorkbook.Sheets("Sheet1")
With Sourcesht
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
Set WordRange = .Range("A1:A" & LastRow)
End With

fileToOpen = Application _
.GetOpenFilename("Excel Files (*.xls), *.xls")
If fileToOpen = False Then
MsgBox ("Cannot Open file - Exiting Macro")
End
End If

Set destBk = Workbooks.Open(Filename:=fileToOpen)
For Each sht In destBk.Sheets
For Each wrd In WordRange
Set c = sht.Cells.Find(what:=wrd, _
LookIn:=xlValues, _
lookat:=xlPart)
If Not c Is Nothing Then
FirstAddr = c.Address
Do

With c.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 3
End With
With c.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 3
End With
With c.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 3
End With
With c.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 3
End With


WordLength = Len(wrd)
OldStartPos = 1
Do
'find position of character
StartPos = InStr(OldStartPos, c, wrd)
If StartPos 0 Then
With c.Characters(Start:=StartPos, _
Length:=WordLength).Font

.FontStyle = "Bold"
.ColorIndex = 3
End With

OldStartPos = StartPos + WordLength
End If

Loop While StartPos 0

Set c = sht.Cells.FindNext(after:=c)
Loop While Not c Is Nothing And c.Address < FirstAddr
End If
Next wrd

Next sht

end sub

--------------------


--
joel
------------------------------------------------------------------------
joel's Profile: 229
View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=182954

Microsoft Office Help