enhance a function of single character to a combination

[ela]

some time ago, I was kindly provided with a primitive codes followed with my
modifications as follows. The function is capable of coloring a text pattern
input by users. I would like to enhance it to a more robust way in:

1) instead of adding escape character for ], ', etc. is there any way to let
the program know I'm specifying symbols for the checklist?

2) instead of requiring users to input the patterns one by one, can I do
anything to let them input the patterns only once? e.g.

something like:

[boy|girl]

so the program colors either boy or girl, rather than letting the user input
"boy" and then "girl"?

==============================
Option Explicit
Sub RedLetter()
Dim s As String * 1
Dim c As Range
Dim i As Long

s = InputBox("Which letter to redden?")

If s Like "[!A-Za-z\[\]]" Then
MsgBox ("Must specify a LETTER")
Exit Sub
End If

For Each c In Selection
With c
If .HasFormula Then .Value = .Text
'.Font.TintAndShade = -0.5
For i = 1 To Len(.Text)
If LCase(Mid(.Text, i, 1)) = LCase(s) Then
.Characters(i, 1).Font.Color = RGB(255, 30, 15)
End If
Next i
End With
Next c
End Sub

 

[JLatham]

I believe the code below will perform as you have requested. Instead of the
| character, I have set up to use the / character, but that is easily changed
in the code. I think the / is more visible than the | and that may make
reading the list that has been entered to make certain it is complete easier
to do.

When prompted, simply enter your list, with each group separated, like
boy/girl/red/green
or if your list is only a single group, just enter it as:
boy
or even a single letter, as
a

Sub ColorByLetterPattern()
Const separatorCharacter = "/" ' change separator as desired
Dim sourcePattern As String
Dim currentPattern As String
Dim patternLength As Integer
Dim anyCell As Range
Dim targetText As String
Dim LC As Integer ' loop counter

sourcePattern = InputBox("Enter your groups to make red" _
& vbCrLf & "separated with the " _
& separatorCharacter & " character.", "Letter Patterns", "")
If Trim(sourcePattern) = "" Then
Exit Sub
End If
'to make things easier, we will add a separatorCharacter to the end
'of the input value
sourcePattern = Trim(sourcePattern) & separatorCharacter

Do While Len(sourcePattern) > 0
currentPattern = Left(sourcePattern, _
InStr(sourcePattern, separatorCharacter))
'remove from sourcePattern
sourcePattern = Right(sourcePattern, _
Len(sourcePattern) - Len(currentPattern))
'remove separatorCharacter from currentPattern
currentPattern = UCase(Left(currentPattern, Len(currentPattern) - 1))
'now work through the text in the cell(s) to highlight
'matched patterns; this is set up so that case does not matter
For Each anyCell In Selection
'only test if the pattern can fit inside of the
'current cell's text length
patternLength = Len(currentPattern)
If Len(anyCell.Text) >= patternLength Then
With anyCell
For LC = 1 To (Len(.Text) - patternLength)
If UCase(Mid(.Text, LC, patternLength)) = currentPattern Then
.Characters(LC, patternLength).Font.Color = RGB(255, 30, 15)
End If
Next ' end of LC loop
End With
End If
Next ' end of anyCell loop
Loop
End Sub

some time ago, I was kindly provided with a primitive codes followed with my
modifications as follows. The function is capable of coloring a text pattern
input by users. I would like to enhance it to a more robust way in:

1) instead of adding escape character for ], ', etc. is there any way to let
the program know I'm specifying symbols for the checklist?

2) instead of requiring users to input the patterns one by one, can I do
anything to let them input the patterns only once? e.g.

something like:

[boy|girl]

so the program colors either boy or girl, rather than letting the user input
"boy" and then "girl"?

==============================
Option Explicit
Sub RedLetter()
Dim s As String * 1
Dim c As Range
Dim i As Long

s = InputBox("Which letter to redden?")

If s Like "[!A-Za-z\[\]]" Then
MsgBox ("Must specify a LETTER")
Exit Sub
End If

For Each c In Selection
With c
If .HasFormula Then .Value = .Text
'.Font.TintAndShade = -0.5
For i = 1 To Len(.Text)
If LCase(Mid(.Text, i, 1)) = LCase(s) Then
.Characters(i, 1).Font.Color = RGB(255, 30, 15)
End If
Next i
End With
Next c
End Sub


.

 

[Herbert Seidenberg]

Try Tomboy