Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
highlighting cells | Excel Discussion (Misc queries) | |||
Highlighting cells | Excel Discussion (Misc queries) | |||
highlighting cells | Excel Discussion (Misc queries) | |||
Excel,how to turn off "send to" function when highlighting cells? | Excel Discussion (Misc queries) | |||
Highlighting blanks via GO TO SPECIAL is not highlighting blank cells - HELP, I'm totally stuck. | Excel Discussion (Misc queries) |