Hilight row in a table

S

simmo

Hi all,

I have been using this macro to highlight names in a table in word.
Is it possible to modify it, so it will highlight the row that the
name is on in the table with a cell fill colour of say blue.


Thanks

Justin




Sub Namesred()
'
' Macro2 Macro
' Macro recorded 28/04/2008 by Simmo
'
Dim rDcm As Range
Dim x As Long
Dim arrU() As String
Dim arrB() As String
arrU = Split("Y Age%M Arnold%N Barras%K Billing %J Wood", "%")

arrB = Split("RECORD", ",") ' bold
For x = 0 To UBound(arrU)
Set rDcm = ActiveDocument.Range
With rDcm.Find
..Text = "<" & arrU(x) & ">"
..MatchWildcards = True
..Replacement.Font.Color = wdColorRed
..Replacement.Text = "^&"
..Execute Replace:=wdReplaceAll
End With
Next
For x = 0 To UBound(arrB)
Set rDcm = ActiveDocument.Range
With rDcm.Find
..Text = "<" & arrB(x) & ">"
..MatchWildcards = True
..Replacement.Font.Bold = True
..Replacement.Text = "^&"
..Execute Replace:=wdReplaceAll
End With
Next
ActiveDocument.Range(0, 0).Select
End Sub
 
G

Graham Mayor

Assuming the arrays are correct then

Sub Namesred()
Dim x As Long
Dim oRng As Range
Dim arrU As Variant
Dim arrB As Variant
arrU = Split("Y Age%M Arnold%N Barras%K Billing%J Wood", "%")
arrB = Split("RECORD", ",") ' bold
For x = 0 To UBound(arrU)
Selection.HomeKey wdStory
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
While .Execute(findText:="<" & arrU(x) & ">", MatchWildcards:=True)
Set oRng = Selection.Range
With oRng
.Font.Color = wdColorRed
.Collapse wdCollapseEnd
End With
Wend
End With
Next
For x = 0 To UBound(arrB)
Selection.HomeKey wdStory
With Selection.Find
While .Execute(findText:="<" & arrB(x) & ">", MatchWildcards:=True)
Set oRng = Selection.Range
With oRng
.Font.Bold = True
sRow = .Information(wdStartOfRangeRowNumber)
ActiveDocument.Tables(1).Rows(sRow).Shading.BackgroundPatternColor
_
= wdColorLightBlue
.Collapse wdCollapseEnd
End With
Wend
End With
Next
ActiveDocument.Tables(1).Cell(1, 1).Select
End Sub

will work

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
 
S

simmo

Assuming the arrays are correct then

Sub Namesred()
Dim x As Long
Dim oRng As Range
Dim arrU As Variant
Dim arrB As Variant
arrU = Split("Y  Age%M  Arnold%N  Barras%K  Billing%J  Wood","%")
arrB = Split("RECORD", ",") ' bold
For x = 0 To UBound(arrU)
    Selection.HomeKey wdStory
    With Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        While .Execute(findText:="<" & arrU(x) & ">", MatchWildcards:=True)
            Set oRng = Selection.Range
            With oRng
                .Font.Color = wdColorRed
                .Collapse wdCollapseEnd
            End With
        Wend
    End With
Next
For x = 0 To UBound(arrB)
Selection.HomeKey wdStory
With Selection.Find
    While .Execute(findText:="<" & arrB(x) & ">", MatchWildcards:=True)
        Set oRng = Selection.Range
        With oRng
            .Font.Bold = True
            sRow = .Information(wdStartOfRangeRowNumber)
            ActiveDocument.Tables(1).Rows(sRow).Shading.BackgroundPatternColor
_
                = wdColorLightBlue
            .Collapse wdCollapseEnd
        End With
    Wend
End With
Next
ActiveDocument.Tables(1).Cell(1, 1).Select
End Sub

will work

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor -  Word MVP

My web sitewww.gmayor.com
Word MVP web sitehttp://word.mvps.org
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>






- Show quoted text -
Click to expand...

Hi Graham

Thanks for taking the time to help.
I tried the macro it still works but does not highlight the back
ground of the cells within the table.

I’m using word 2000 if that makes a difference.

Thanks once again
 
G

Graham Mayor

simmo said:
Hi Graham

Thanks for taking the time to help.
I tried the macro it still works but does not highlight the back
ground of the cells within the table.

I’m using word 2000 if that makes a difference.

Thanks once again
Click to expand...

It works in Word 2003, but I regret I don't have access to Word 2000. Maybe
someone who does will come to the rescue.

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
 
S

simmo

It works in Word 2003, but I regret I don't have access to Word 2000. Maybe
someone who does will come to the rescue.

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor -  Word MVP

My web sitewww.gmayor.com
Word MVP web sitehttp://word.mvps.org
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Click to expand...

I must be doing something wrong i tried it in word 2003 and it still
did not work
I have pasted the code that i used below

Thanks for your time


Sub Namesred11()
Dim x As Long
Dim oRng As Range
Dim arrU As Variant
Dim arrB As Variant
arrU = Split("Y Age%M Arnold%N Barras%K Billing%J Brady%J Wood",
"%")
arrB = Split("RECORD", ",") ' bold
For x = 0 To UBound(arrU)
Selection.HomeKey wdStory
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
While .Execute(findText:="<" & arrU(x) & ">",
MatchWildcards:=True)
Set oRng = Selection.Range
With oRng
.Font.Color = wdColorRed
.Collapse wdCollapseEnd
End With
Wend
End With
Next
For x = 0 To UBound(arrB)
Selection.HomeKey wdStory
With Selection.Find
While .Execute(findText:="<" & arrB(x) & ">",
MatchWildcards:=True)
Set oRng = Selection.Range
With oRng
.Font.Bold = True
sRow = .Information(wdStartOfRangeRowNumber)
ActiveDocument.Tables(1).Rows
(sRow).Shading.BackgroundPatternColor = wdColorLightBlue
.Collapse wdCollapseEnd
End With
Wend
End With
Next
ActiveDocument.Tables(1).Cell(1, 1).Select
End Sub
 
G

Graham Mayor

There are a couple of broken lines in the macro thanks to the message
format,. but they are easily straightened out (the version below should
avoid that issue apart from perhaps your first array)

I don't have access to your table so I created a table and in random cells I
inserted the names from your first array and in some cells I inserted RECORD
the search item from your second array (though you don't need an array for
just one search item), Come to that you can do the lot in one pass too (see
macro at the end), but I kept it as close to your original so that you could
follow the changes more easily.

The macro looks for the names in the first array wherever they are in the
table and formats them as red colour
The macro then looks for the word(s) in the second array i.e. RECORD and
formats the whole row in which it appears with a background colour of light
blue and adds the bold attribute to the word itself.

Nothing else in any of the cells apart from the search strings is affected.

It worked exactly as written. It did however occur to me that if you have
more than one table in your document, the rows may not be coloured, so the
following version incorporates a small change to cover that.

Sub Namesred12()
Dim x As Long
Dim oRng As Range
Dim arrU As Variant
Dim arrB As Variant
arrU = Split _
("Y Age%M Arnold%N Barras%K Billing%J Brady%J Wood" _
, "%")
arrB = Split("RECORD", ",") ' bold
For x = 0 To UBound(arrU)
Selection.HomeKey wdStory
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
While .Execute(findText:="<" & arrU(x) _
& ">", MatchWildcards:=True)
Set oRng = Selection.Range
With oRng
.Font.Color = wdColorRed
.Collapse wdCollapseEnd
End With
Wend
End With
Next
For x = 0 To UBound(arrB)
Selection.HomeKey wdStory
With Selection.Find
While .Execute(findText:="<" & arrB(x) _
& ">", MatchWildcards:=True)
Set oRng = Selection.Range
With oRng
.Font.Bold = True
oRng.Rows(1) _
.Shading.BackgroundPatternColor = _
wdColorLightBlue
.Collapse wdCollapseEnd
End With
Wend
End With
Next x
End Sub

and just for the hell of it, the following does the lot with only one list
of variants, laid out as shown for ease of editing.

Sub Namesred13()
Dim x As Long
Dim oRng As Range
Dim arrU(6) As Variant
arrU(0) = "RECORD"
arrU(1) = "Y Age"
arrU(2) = "Arnold"
arrU(3) = "N Barras"
arrU(4) = " K Billing"
arrU(5) = "J Brady"
arrU(6) = "J Wood"

For x = 0 To UBound(arrU)
Selection.HomeKey wdStory
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
While .Execute(findText:="<" & arrU(x) _
& ">", MatchWildcards:=True)
Set oRng = Selection.Range
If x = 0 Then
With oRng
.Font.Bold = True
oRng.Rows(1) _
.Shading.BackgroundPatternColor = _
wdColorLightBlue
.Collapse wdCollapseEnd
End With
Else
With oRng
.Font.Color = wdColorRed
.Collapse wdCollapseEnd
End With
End If
Wend
End With
Next
End Sub

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
 
S

simmo

There are a couple of broken lines in the macro thanks to the message
format,. but they are easily straightened out (the version below should
avoid that issue apart from perhaps your first array)

I don't have access to your table so I created a table and in random cells I
inserted the names from your first array and in some cells I inserted RECORD
the search item from your second array (though you don't need an array for
just one search item), Come to that you can do the lot in one pass too (see
macro at the end), but I kept it as close to your original so that you could
follow the changes more easily.

The macro looks for the names in the first array wherever they are in the
table and formats them as red colour
The macro then looks for the word(s) in the second array i.e. RECORD and
formats the whole row in which it appears with a background colour of light
blue and adds the bold attribute to the word itself.

Nothing else in any of the cells apart from the search strings is affected.

It worked exactly as written. It did however occur to me that if you have
more than one table in your document, the rows may not be coloured, so the
following version incorporates a small change to cover that.

Sub Namesred12()
Dim x As Long
Dim oRng As Range
Dim arrU As Variant
Dim arrB As Variant
arrU = Split _
("Y  Age%M  Arnold%N  Barras%K  Billing%J  Brady%J  Wood" _
, "%")
arrB = Split("RECORD", ",") ' bold
For x = 0 To UBound(arrU)
    Selection.HomeKey wdStory
    With Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        While .Execute(findText:="<" & arrU(x) _
        & ">", MatchWildcards:=True)
            Set oRng = Selection.Range
            With oRng
                .Font.Color = wdColorRed
                .Collapse wdCollapseEnd
            End With
        Wend
    End With
Next
For x = 0 To UBound(arrB)
    Selection.HomeKey wdStory
        With Selection.Find
            While .Execute(findText:="<" & arrB(x) _
            & ">", MatchWildcards:=True)
                Set oRng = Selection.Range
                With oRng
                    .Font.Bold = True
                    oRng.Rows(1) _
                        .Shading.BackgroundPatternColor = _
                        wdColorLightBlue
                    .Collapse wdCollapseEnd
                End With
            Wend
        End With
Next x
End Sub

and just for the hell of it, the following does the lot with only one list
of variants, laid out as shown for ease of editing.

Sub Namesred13()
Dim x As Long
Dim oRng As Range
Dim arrU(6) As Variant
arrU(0) = "RECORD"
arrU(1) = "Y  Age"
arrU(2) = "Arnold"
arrU(3) = "N  Barras"
arrU(4) = " K  Billing"
arrU(5) = "J  Brady"
arrU(6) = "J  Wood"

For x = 0 To UBound(arrU)
    Selection.HomeKey wdStory
    With Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        While .Execute(findText:="<" & arrU(x) _
        & ">", MatchWildcards:=True)
            Set oRng = Selection.Range
            If x = 0 Then
                With oRng
                    .Font.Bold = True
                    oRng.Rows(1) _
                        .Shading.BackgroundPatternColor = _
                        wdColorLightBlue
                    .Collapse wdCollapseEnd
                End With
            Else
                With oRng
                    .Font.Color = wdColorRed
                    .Collapse wdCollapseEnd
                End With
            End If
        Wend
    End With
Next
End Sub

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor -  Word MVP

My web sitewww.gmayor.com
Word MVP web sitehttp://word.mvps.org
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>







- Show quoted text -
Click to expand...

Hi Graham

Thanks for the explanation, it was my fault I didn’t understand the
second array and was not changing the text.

I like the Sub Namesred13() code it looks neater but it didn’t
highlight the rows. It may have something to do with the error message
I got when running Namesred12().

Now that I understand the second array in Namesred12() I have changed
the text to search for some thing within the tables. (I suppose this
does help :- )

But got an error message

Run time error 5991

cannot access individual rows in this collection because the table has
vertically merged cells

The error pointed to this line
ActiveDocument.Tables(1).Rows(sRow).Shading.BackgroundPatternColor =
wdColorLightBlue

The word document contains about 6 tables and some vertically merged
cells.
I apologise as you have probably worked out, I am no expert at this.

Thanks again
 
G

Graham Mayor

We all learn by exploring each others' little puzzles - its one of the
reasons I keep coming back here :)

If you have merged cells in the table then the code will indeed throw an
error. It is simple enough to colour the merged cells containing the found
text e.g.

If x = 0 Then 'the first item in the list of variants
With oRng
.Font.Bold = True
oRng.Cells(1) _
.Shading.BackgroundPatternColor = _
wdColorLightBlue
.Collapse wdCollapseEnd
End With

but then what constitutes the rest of the 'row' that you want colouring?.
Are there any merged (horizontally or vertically) cells in the rest of the
row? If so what parts are to be filled? You can't fill half a merged cell.

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
 
S

simmo

We all learn by exploring each others' little puzzles - its one of the
reasons I keep coming back here :)

If you have merged cells in the table then the code will indeed throw an
error. It is simple enough to colour the merged cells containing the found
text e.g.

If x = 0 Then 'the first item in the list of variants
                With oRng
                    .Font.Bold = True
                    oRng.Cells(1) _
                        .Shading.BackgroundPatternColor = _
                        wdColorLightBlue
                    .Collapse wdCollapseEnd
                End With

but then what constitutes the rest of the 'row' that you want colouring?.
Are there any merged (horizontally or vertically) cells in the rest of the
row? If so what parts are to be filled? You can't fill half a merged cell..

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor -  Word MVP

My web sitewww.gmayor.com
Word MVP web sitehttp://word.mvps.org
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>













- Show quoted text -
Click to expand...

The merged cells only contain titles and can be ignored if it helps.

Just to see one blue line appear after a running the macro would make
it all worth while.
You must have the patients of a saint.
 
S

simmo

The merged cells only contain titles and can be ignored if it helps.

Just to see one blue line appear after a running the macro would make
it all worth while.
You must have the patients of a saint.- Hide quoted text -

- Show quoted text -
Click to expand...

Yes it has and horizontally or vertically merged cells
 
S

simmo

Yes it has and horizontally or vertically merged cells- Hide quoted text -

- Show quoted text -
Click to expand...

I saw a blue line wooohooo

It is defiantly something to do with the horizontally or vertically
merged cells, Namesred12() I got to work without the merged cells but
Namesred13() I cant get to highlight.
 
G

Graham Mayor

simmo said:
I saw a blue line wooohooo

It is defiantly something to do with the horizontally or vertically
merged cells, Namesred12() I got to work without the merged cells but
Namesred13() I cant get to highlight.
Click to expand...

13 is not going to work unless you change oRng.Rows(1) in

If x = 0 Then
With oRng
.Font.Bold = True
oRng.Rows(1) _
.Shading.BackgroundPatternColor = _
wdColorLightBlue
.Collapse wdCollapseEnd
End With

to oRng.Cells(1)

This will then put a background fill in the cell that contains the first
word in the list of variants arrU(0) ie RECORD
The <> brackets around the search string are superfluous. However the spaces
between the words in the Variants must match what you are searching for in
the document.

Sub Namesred14()
Dim x As Long
Dim oRng As Range
Dim arrU(6) As Variant
arrU(0) = "RECORD"
arrU(1) = "Y Age"
arrU(2) = "Arnold"
arrU(3) = "N Barras"
arrU(4) = " K Billing"
arrU(5) = "J Brady"
arrU(6) = "J Wood"

For x = 0 To UBound(arrU) 'test each variant in turn
Selection.HomeKey wdStory 'go to the start of the document
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
While .Execute(findText:= arrU(x), _
MatchWildcards:=True)
Set oRng = Selection.Range 'mark the found text
If x = 0 Then 'Item is the first varient in the list
With oRng 'so make it bold and set the
'background of the cell to blue
.Font.Bold = True
oRng.Cells(1) _
.Shading.BackgroundPatternColor = _
wdColorLightBlue
.Collapse wdCollapseEnd
End With
Else 'Item is not the first
With oRng 'so colour it red
.Font.Color = wdColorRed
.Collapse wdCollapseEnd
End With
End If
Wend
End With
Next 'now look for the next string
End Sub

With merged cells, there is no practical way I can think of for continuing
the fill across the width of the table and having a neat bar across the
table.

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
 
S

simmo

13 is not going to work unless you change oRng.Rows(1) in

If x = 0 Then
                With oRng
                    .Font.Bold = True
                    oRng.Rows(1) _
                        .Shading.BackgroundPatternColor = _
                        wdColorLightBlue
                    .Collapse wdCollapseEnd
                End With

to oRng.Cells(1)

This will then put a background fill in the cell that contains the first
word in the list of variants arrU(0) ie RECORD
The <> brackets around the search string are superfluous. However the spaces
between the words in the Variants must match what you are searching for in
the document.

Sub Namesred14()
Dim x As Long
Dim oRng As Range
Dim arrU(6) As Variant
arrU(0) = "RECORD"
arrU(1) = "Y Age"
arrU(2) = "Arnold"
arrU(3) = "N Barras"
arrU(4) = " K Billing"
arrU(5) = "J Brady"
arrU(6) = "J Wood"

For x = 0 To UBound(arrU) 'test each variant in turn
    Selection.HomeKey wdStory 'go to the start of the document
    With Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        While .Execute(findText:= arrU(x), _
            MatchWildcards:=True)
            Set oRng = Selection.Range 'mark the found text
            If x = 0 Then 'Item is the first varient in thelist
                With oRng 'so make it bold and set the
                                  'background of the cell to blue
                    .Font.Bold = True
                    oRng.Cells(1) _
                        .Shading.BackgroundPatternColor = _
                        wdColorLightBlue
                    .Collapse wdCollapseEnd
                End With
            Else 'Item is not the first
                With oRng 'so colour it red
                    .Font.Color = wdColorRed
                    .Collapse wdCollapseEnd
                End With
            End If
        Wend
    End With
Next 'now look for the next string
End Sub

With merged cells, there is no practical way I can think of for continuing
the fill across the width of the table and having a neat bar across the
table.

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor -  Word MVP

My web sitewww.gmayor.com
Word MVP web sitehttp://word.mvps.org
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Click to expand...

I have learnt a lot in the last few days, one of them being my
girlfriend is not very happy with me sitting if front of the PC all
day, the other is how fulfilling it is to slowly start to understand a
little more VB code. I appreciate all your help.

Do you write code for a living or is it a hobby. Some lovely photos of
Cyprus on your web page. I was based their for six months a few years
ago and have been back three times since on holiday.

Is it possible to ignore the merged cells in the search so the macro
will work. The only content in the rows with merged cells are titles
and don’t need to be searched.

Would It be ok to send you an email, my email address is
(e-mail address removed) if not I understand you don’t know what type
of lunatic you might be communicating with on the internet, im just
interested to learn a bit more and would like to deal directly,
obviously for a price.

Thanks again
 
G

Graham Mayor

simmo said:
I have learnt a lot in the last few days, one of them being my
girlfriend is not very happy with me sitting if front of the PC all
day, the other is how fulfilling it is to slowly start to understand a
little more VB code. I appreciate all your help.

Do you write code for a living or is it a hobby. Some lovely photos of
Cyprus on your web page. I was based their for six months a few years
ago and have been back three times since on holiday.

Is it possible to ignore the merged cells in the search so the macro
will work. The only content in the rows with merged cells are titles
and don’t need to be searched.

Would It be ok to send you an email, my email address is
@@@@@@@ if not I understand you don’t know what type
of lunatic you might be communicating with on the internet, im just
interested to learn a bit more and would like to deal directly,
obviously for a price.

Thanks again
Click to expand...

The following version will work even if the cells are merged, by processing
the adjacent cells separately but if any of the cells are vertically merged,
you will get some very odd results, as the merged cells in the 'row' will be
filled to produce 'battlements' ;)

Sub Namesred15()
Dim x As Long
Dim oRng As Range
Dim arrU(6) As Variant
arrU(0) = "RECORD"
arrU(1) = "Y Age"
arrU(2) = "Arnold"
arrU(3) = "N Barras"
arrU(4) = " K Billing"
arrU(5) = "J Brady"
arrU(6) = "J Wood"

For x = 0 To UBound(arrU) 'test each variant in turn
Selection.HomeKey wdStory 'go to the start of the document
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
While .Execute(findText:=arrU(x), _
MatchWildcards:=True)
Set oRng = Selection.Range 'mark the found text
If x = 0 Then 'Item is the first variant in the list
With oRng 'so make it bold and set the
'background of the cell to blue
.Font.Bold = True
.MoveEnd wdRow, 1 'Move end of range to
'end of row
.MoveStart wdRow, -1 'Move start of range to
'beginning of row
For i = 1 To .Cells.Count 'Count the cells
'in the row and process each of them to add
'blue shading
.Cells(i) _
.Shading.BackgroundPatternColor = _
wdColorLightBlue
Next i
.Collapse wdCollapseEnd
End With
Else 'Item is not the first
With oRng 'so colour it red
.Font.Color = wdColorRed
.Collapse wdCollapseEnd
End With
End If
Wend
End With
Next 'now look for the next string
End Sub

As you have visited my web site, you could have spotted that I am retired
and I frequent the Word forums and maintain the web site to keep my brain
working. The photographs on the web site are a reflection of the fact that I
live in Cyprus. If you are thinking of coming over for holiday this year,
the current value of the GB pound will make it an expensive visit :(

I do try and answer questions related to my web site from correspondents who
use the link on my home page with matters related to the web site, but I do
not offer private consultancy. If that is what you require, several of my
fellow Word MVPs scattered around the world will be happy to take your
money. And donations to my web site are always appreciated from those who
find the material there useful.

By frequenting this forum particularly - to which end you may find
http://www.gmayor.com/MSNews.htm a more practical means of accessing it -
you will learn far more about vba programming by experimenting and asking
questions when you get stuck. There are several people regularly
contributing here who are better programmers than I would ever try and claim
to be and few are the questions that go unanswered.

However you may find accessing this forum and the associated puzzle solving
somewhat addictive, so if you neglect that girlfriend, don't be too
surprised if she moves on ;)

PS It is not a good idea to use a valid e-mail address in these forums - you
could end up with more than your share of spam as a result. If your ISP does
not offer spam filtering, see
http://www.gmayor.com/use_google_gmail_to_remove_spam.htm

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
 
S

simmo

I have set up the newsgroup reader in Outlook and am giving it a go.



I didn't want to take advantage of the help you were giving me I know what
it is like when someone keeps on and on.



Sub Namesred15() was highlighting the row above the one that was searched
for as well.

So I changed .MoveStart wdRow, -1 to .MoveStart wdRow, 0 after a bit of
trial and error and it worked, to my surprise.



Is it possible I highlight all of these not just arrU(0) = "RECORD"



arrU(0) = "RECORD"

arrU(1) = "Y Age"

arrU(2) = "Arnold"

arrU(3) = "N Barras"

arrU(4) = " K Billing"

arrU(5) = "J Brady"

arrU(6) = "J Wood"



I've tried playing with this line but can't work out how to select them all



If x = 0 Then 'Item is the first variant in the list



I tried If x = 0 - 6 and also If x = 0 to 6 but to is obviously not VB code.



My girlfriend likes the cat photos.



I don't know how this is going to look once I post it as I've never used a
news group before.
 
G

Graham Mayor

At present the macro followed your original lead and set the background to
RECORD whilst all the other entries are coloured red. If you want all the
items coloured remove the condition If x = 0 which restricts the macro to
processing only the first item in that section (and the associated ELSE to
ENDIF lines as shown below)

If you want to process each arrU selection differently then look in vba help
for the use of CASE.

Sub Namesred15()
Dim x As Long
Dim oRng As Range
Dim arrU(6) As Variant
arrU(0) = "RECORD"
arrU(1) = "Y Age"
arrU(2) = "Arnold"
arrU(3) = "N Barras"
arrU(4) = " K Billing"
arrU(5) = "J Brady"
arrU(6) = "J Wood"

For x = 0 To UBound(arrU) 'test each variant in turn
Selection.HomeKey wdStory 'go to the start of the document
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
While .Execute(findText:=arrU(x), _
MatchWildcards:=True)
Set oRng = Selection.Range 'mark the found text
'If x = 0 Then 'Item is the first variant in the list
With oRng 'so make it bold and set the
'background of the cell to blue
.Font.Bold = True
.MoveEnd wdRow, 1 'Move end of range to
'end of row
.MoveStart wdRow, -1 'Move start of range to
'beginning of row
For i = 1 To .Cells.Count 'Count the cells
'in the row and process each of them to add
'blue shading
.Cells(i) _
.Shading.BackgroundPatternColor = _
wdColorLightBlue
Next i
.Collapse wdCollapseEnd
End With
'Else 'Item is not the first
' With oRng 'so colour it red
' .Font.Color = wdColorRed
' .Collapse wdCollapseEnd
' End With
'End If
Wend
End With
Next 'now look for the next string
End Sub


--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
 
G

Graham Mayor

You are welcome :)

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Hilight a row in a table 2
Word macro that can call cells out of Excel for a find and replace 0
Extract Text in braquet and list of terms from 2 Docs 3
Word Macro for multiple searches, incl. in footnotes 2
font color 2
Copying the result of a macro to the Clipboard 2
Nesting Find and Replace Macros 2
This Code does not work 8

Top