R
Runt
I have a funcion call replacewords() that removes words form sentneces
if they appear in another cell. I want to highlight those cells where
the macro fails to find a word. To this end, I add the following code
to the function...
' Highlight those ENTRIES where a word was not located
With rng
.Interior.ColorIndex = 15
.Interior.Pattern = xlSolid
.Font.Bold = True
.Font.Size = 14
End With
but it doesn't seem to be doing anything to the cell formats at all.
The macro itself works, but I can't get it to have any effect on cell
formats.
Any ideas? Cheers,
Chris
Here is the entire function...
Option Explicit
Function replacewords(rng As Range, rng2 As Range, _
Optional WithString As String = "...") As
String
Dim mySent As String
Dim myEnt As String
Dim newSent As String
Dim sentArray As Variant
Dim entArray As Variant
Dim i As Integer
Dim j As Integer
Dim entnum As Integer
Dim mySpace As String
myEnt = rng(1).Value
mySent = rng2(1).Value
newSent = ""
sentArray = Split(mySent, " ", , vbTextCompare)
entArray = Split(myEnt, " ", , vbTextCompare)
i = 0
j = 0
entnum = UBound(entArray, 1) - LBound(entArray, 1) + 1
'if only one word in ENTRY field and it appears in the sentence then
'replace the word with "..." if identical
If entnum = 1 And InStr(1, mySent, myEnt, vbTextCompare) Then
newSent = Replace(mySent, myEnt, "...", 1, 1, vbTextCompare)
GoTo endgame
End If
'if more than one word in ENTRY and exact entry appears in sentence
then
'replace each word with amount of "..." as was words in entry
If InStr(1, mySent, myEnt, vbTextCompare) Then
For i = 1 To entnum
mySpace = mySpace & "... "
Next i
newSent = Replace(mySent, myEnt, mySpace, 1, 1, vbTextCompare)
GoTo endgame
End If
'Otherwise, loop through words in sentence and built a new setence
'where matching or near matching words with a replaced by "... "
For j = 0 To UBound(sentArray)
For i = 0 To UBound(entArray)
If LCase(entArray(i)) = LCase(sentArray(j)) Then
newSent = newSent & "... "
GoTo exitloop
End If
If LCase(Mid(entArray(i), 1, 3)) = LCase(Mid(sentArray(j), 1,
3)) Then
newSent = newSent & "... "
GoTo exitloop
End If
' Highlight those ENTRIES where a word was not located
With rng
.Interior.ColorIndex = 15
.Interior.Pattern = xlSolid
.Font.Bold = True
.Font.Size = 14
End With
Next i
newSent = newSent & sentArray(j) & " "
exitloop:
Next j
endgame:
newSent = Replace(newSent, " ", " ")
replacewords = newSent
End Function
if they appear in another cell. I want to highlight those cells where
the macro fails to find a word. To this end, I add the following code
to the function...
' Highlight those ENTRIES where a word was not located
With rng
.Interior.ColorIndex = 15
.Interior.Pattern = xlSolid
.Font.Bold = True
.Font.Size = 14
End With
but it doesn't seem to be doing anything to the cell formats at all.
The macro itself works, but I can't get it to have any effect on cell
formats.
Any ideas? Cheers,
Chris
Here is the entire function...
Option Explicit
Function replacewords(rng As Range, rng2 As Range, _
Optional WithString As String = "...") As
String
Dim mySent As String
Dim myEnt As String
Dim newSent As String
Dim sentArray As Variant
Dim entArray As Variant
Dim i As Integer
Dim j As Integer
Dim entnum As Integer
Dim mySpace As String
myEnt = rng(1).Value
mySent = rng2(1).Value
newSent = ""
sentArray = Split(mySent, " ", , vbTextCompare)
entArray = Split(myEnt, " ", , vbTextCompare)
i = 0
j = 0
entnum = UBound(entArray, 1) - LBound(entArray, 1) + 1
'if only one word in ENTRY field and it appears in the sentence then
'replace the word with "..." if identical
If entnum = 1 And InStr(1, mySent, myEnt, vbTextCompare) Then
newSent = Replace(mySent, myEnt, "...", 1, 1, vbTextCompare)
GoTo endgame
End If
'if more than one word in ENTRY and exact entry appears in sentence
then
'replace each word with amount of "..." as was words in entry
If InStr(1, mySent, myEnt, vbTextCompare) Then
For i = 1 To entnum
mySpace = mySpace & "... "
Next i
newSent = Replace(mySent, myEnt, mySpace, 1, 1, vbTextCompare)
GoTo endgame
End If
'Otherwise, loop through words in sentence and built a new setence
'where matching or near matching words with a replaced by "... "
For j = 0 To UBound(sentArray)
For i = 0 To UBound(entArray)
If LCase(entArray(i)) = LCase(sentArray(j)) Then
newSent = newSent & "... "
GoTo exitloop
End If
If LCase(Mid(entArray(i), 1, 3)) = LCase(Mid(sentArray(j), 1,
3)) Then
newSent = newSent & "... "
GoTo exitloop
End If
' Highlight those ENTRIES where a word was not located
With rng
.Interior.ColorIndex = 15
.Interior.Pattern = xlSolid
.Font.Bold = True
.Font.Size = 14
End With
Next i
newSent = newSent & sentArray(j) & " "
exitloop:
Next j
endgame:
newSent = Replace(newSent, " ", " ")
replacewords = newSent
End Function