VBA: color given data with given color.

[jadgon]

VBA: color given data with given color.

Sheet named "USA" has multiple columns. In each columns I have data ( with or with out gap strings or numbers). I have colored each column data with a different color. Say "Data in Column A is blue", "Data in Column C is Red" , "Data in Column B data is Green"........ upto any column. Any column data will not match with one another.

Now in multiple sheets if there is any data appears anywhere and if any string or number matched with data ( with or with out gap strings or numbers) from Sheet named "USA" then color the appearing string or number with the given color.

[SamT]

Some Text


3





This is some text


1234


Like this?

[jadgon]

Yes.

[SamT]

wow

[p45cal]

Click the button in the attached. Case insensitive.
Macro code is:
Sub blah()
For Each cll In Sheets("USA").UsedRange.Cells
myPhrase = Trim(cll.Value)
phraseLength = Len(myPhrase)
If phraseLength > 0 Then
clr = cll.Font.Color
For Each sht In ThisWorkbook.Sheets
If sht.Name <> "USA" Then
For Each celle In sht.UsedRange
x = InStr(1, celle.Value, myPhrase, vbTextCompare)
If x > 0 Then celle.Characters(Start:=x, Length:=phraseLength).Font.Color = clr
Next celle
End If
Next sht
End If
Next cll
End Sub

[jadgon]

Thank you PASCAL.
And if I also want to see the partially matching with regex.

[p45cal]

Supply the regex code and examples of what you're after. Say, in a workbook.

[jadgon]

Simply say I want to match upto 3 letters only and want to color with below plan. [Gaps in-between, before and after is considered]

Multi ply = Multi ply
Multiply = Multi pl
Multiply = Multi p
Multiply = Multi
Multiply = Mult
Multiply = Mul

[jadgon]

I request another VBA code to consider color up to 4 charterer match.

[p45cal]

Supply the regex code and examples of what you're after. For example a few cells showing the text before highlighting, some cells showing what you're looking for, and some clls where you've manually highlighted the corresponding parts - in a workbook.
I can't make any sense out of your msg#8.
The code I supplied will allow you to consider any number of charterers match.

[jadgon]

Here it is..

[p45cal]

try:
Sub blah2()
For Each cll In Sheets("USA").UsedRange.Cells
myPhrase = Trim(cll.Value)
phraseLength = Len(myPhrase)
For j = phraseLength To 4 Step -1
For i = 1 To phraseLength - 3
myNewPhrase = Trim(Mid(myPhrase, i, j))
myNewPhraselength = Len(myNewPhrase)
If myNewPhraselength > 0 Then
clr = cll.Font.Color
For Each sht In ThisWorkbook.Sheets
If sht.Name <> "USA" Then
For Each celle In sht.UsedRange
x = InStr(1, celle.Value, myNewPhrase, vbTextCompare)
If x > 0 Then
celle.Characters(Start:=x, Length:=myNewPhraselength).Font.Color = clr
Do
x = InStr(x + 1, celle.Value, myNewPhrase, vbTextCompare)
If x > 0 Then celle.Characters(Start:=x, Length:=myNewPhraselength).Font.Color = clr
Loop Until x = 0
End If
Next celle
End If
Next sht
End If
Next i
Next j
Next cll
End Sub
It uses a brute force technique so be prepared to wait (15 secs here).

[jadgon]

Thank you.....
Then I want to extract them in Canada sheet...please have a look.

[jadgon]

Can we get this as well as in the excel file ?

[jadgon]

Hello pascal one last issue. I have attached a file in 2nd last post.

[jadgon]

Hello I am looking for a VBA code for last attachment p45cal (http://www.vbaexpress.com/forum/member.php?3494-p45cal)

[jadgon]

Can I get all words or shared words in cells that are in color (partial/full) in cells of a new sheet?