Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 5
Default Highlighting cells with vba function

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
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 134
Default Highlighting cells with vba function

untested but try replacing rng with i
I think that vb cant associate rng with i and therfore
does nothing. I'm guessing. and i don't have your data to
test it.
-----Original Message-----
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
.

  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 27,285
Default Highlighting cells with vba function

Not sure I follow your reasoning Frank. Perhaps try this:

Sub Coloremallatonce()
Dim rng As Range
Set rng = Range("A1,B9,C11:C15,R21,H1,F3")
With rng
.Interior.ColorIndex = 15
.Interior.Pattern = xlSolid
.Font.Bold = True
.Font.Size = 14
End With
End Sub


you don't need an "i" or any type of loop. As I see it, the question is,
what does "rng" reference in Runt's case.

If I were runt, I would format the entire rng being checked with the above
settings (all in one go), then as I went through the rng finding the word, I
would change those cells back to normal - end result being the cells without
the workd would be appropriately marked. Now if he is using the replace
method on multiple cells at once, then that wouldn't be a workable solution.

--
Regards,
Tom Ogilvy

"Frank stone" wrote in message
...
untested but try replacing rng with i
I think that vb cant associate rng with i and therfore
does nothing. I'm guessing. and i don't have your data to
test it.
-----Original Message-----
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
.



Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
highlighting cells [email protected] Excel Discussion (Misc queries) 0 June 16th 08 07:11 PM
Highlighting cells Justin Excel Discussion (Misc queries) 0 August 15th 07 05:14 PM
highlighting cells Candace Excel Discussion (Misc queries) 1 November 2nd 06 06:46 PM
Excel,how to turn off "send to" function when highlighting cells? DNAISH Excel Discussion (Misc queries) 4 September 6th 06 04:58 PM
Highlighting blanks via GO TO SPECIAL is not highlighting blank cells - HELP, I'm totally stuck. Jamie Furlong Excel Discussion (Misc queries) 6 August 28th 05 09:27 PM


All times are GMT +1. The time now is 02:49 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"