Search within a word table

[simmo]

Hi All

I am trying to use this macro to search a word doc that contains a
table. Within the table there are lot of columns and rows that contain
times and numbers which for ease of explanation I will call cells hope
this is the right terminology.

I would like to highlight a single cell that contains just the number
14 but this macro will highlight all 14’s within the doc including the
times for instance 10:14

Is it possible to target single cells that contain just the numbers 14
on their own.

I am new to macros so this one may look crude

If this is relatively easy my final aim is to create a macro that can
search for say five different numbers and highlight them different
colours.

Thank you


Sub 14light()
'
' Macro1 Macro
' Macro recorded 10/19/2008 by sim
'
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "14"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With


Selection.Find.Execute
While Selection.Find.Found
Selection.MoveLeft Unit:=wdCharacter, Count:=2
Selection.MoveRight Unit:=wdCharacter, Count:=4, Extend:=wdExtend
Selection.Shading.Texture = wdTextureNone
Selection.Shading.ForegroundPatternColor = wdColorAutomatic
Selection.Shading.BackgroundPatternColor = wdColorYellow
Selection.MoveRight Unit:=wdCharacter, Count:=1


Selection.Find.Execute
Wend

End Sub

 

[Graham Mayor]

Assuming the first table - table(1) then

Sub HiLightNumbers()
Dim oCell As Range
With ActiveDocument.Tables(1)
For i = 1 To .Rows.Count
For j = 1 To .Columns.Count
Set oCell = .Cell(i, j).Range
oCell.End = oCell.End - 1
Select Case oCell.Text
Case Is = "14"
oCell.HighlightColorIndex = wdYellow
Case Is = "12"
oCell.HighlightColorIndex = wdPink
Case Is = "10"
oCell.HighlightColorIndex = wdTeal
Case Else
oCell.HighlightColorIndex = wdNoHighlight
End Select
Next j
Next i
End With
End Sub

will highlight 14 12 and 10 in different colours. Add case statements and
numbers as appropriate.

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


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

 

[Helmut Weber]

Hi simmo,

something along these lines:

Sub TestaaB()
Dim rDcm As Range
Set rDcm = ActiveDocument.Range
With rDcm.Find
.Text = "14"
While .Execute
If rDcm.Information(wdWithInTable) Then
If Len(rDcm.Cells(1).Range) = 4 Then
rDcm.HighlightColorIndex = wdYellow
' and more formatting, just as you like
End If
End If
Wend
End With
End Sub
--

Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Vista Small Business, Office XP

 

[simmo]

Assuming the first table - table(1) then

Sub HiLightNumbers()
Dim oCell As Range
    With ActiveDocument.Tables(1)
        For i = 1 To .Rows.Count
            For j = 1 To .Columns.Count
                Set oCell = .Cell(i, j).Range
                oCell.End = oCell.End - 1
                Select Case oCell.Text
                    Case Is = "14"
                        oCell.HighlightColorIndex= wdYellow
                    Case Is = "12"
                        oCell.HighlightColorIndex= wdPink
                    Case Is = "10"
                        oCell.HighlightColorIndex= wdTeal
                    Case Else
                        oCell.HighlightColorIndex= wdNoHighlight
                    End Select
            Next j
        Next i
    End With
End Sub

will highlight 14 12 and 10 in different colours. Add case statements and
numbers as appropriate.

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

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

Hi Graham,

Thanks for replying

I got this error when I tried to run to the macro

Run time error 5941
The requested member of the selection does not exist

And its pointing to this line. Set oCell = .Cell(i,
j).Range

 

[simmo]

Hi simmo,

something along these lines:

Sub TestaaB()
Dim rDcm As Range
Set rDcm = ActiveDocument.Range
With rDcm.Find
   .Text = "14"
   While .Execute
      If rDcm.Information(wdWithInTable) Then
         If Len(rDcm.Cells(1).Range) = 4 Then
            rDcm.HighlightColorIndex = wdYellow
            ' and more formatting, just as you like
         End If
      End If
   Wend
End With
End Sub
--

Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Vista Small Business, Office XP

Hi Helmut,

Thanks for replying

This worked

Is it possible to add more searches as with grahams code.

Thanks again for replying

Sub TestaaB()
Dim rDcm As Range
Set rDcm = ActiveDocument.Range
With rDcm.Find
.Text = "14"
While .Execute
If rDcm.Information(wdWithInTable) Then
If Len(rDcm.Cells(1).Range) = 4 Then
rDcm.HighlightColorIndex = wdPink

.Text = "12"
While .Execute
If rDcm.Information(wdWithInTable) Then
If Len(rDcm.Cells(1).Range) = 4 Then
rDcm.HighlightColorIndex = wdYellow

' and more formatting, just as you like
End If
End If
Wend
End With
End Sub

I did try this but as I said earlier I still haven’t grasped the
concept of coding yet

 

[Doug Robbins - Word MVP]

That should all be on one line

Set oCell = .Cell(i, j).Range

--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

Assuming the first table - table(1) then

Sub HiLightNumbers()
Dim oCell As Range
With ActiveDocument.Tables(1)
For i = 1 To .Rows.Count
For j = 1 To .Columns.Count
Set oCell = .Cell(i, j).Range
oCell.End = oCell.End - 1
Select Case oCell.Text
Case Is = "14"
oCell.HighlightColorIndex = wdYellow
Case Is = "12"
oCell.HighlightColorIndex = wdPink
Case Is = "10"
oCell.HighlightColorIndex = wdTeal
Case Else
oCell.HighlightColorIndex = wdNoHighlight
End Select
Next j
Next i
End With
End Sub

will highlight 14 12 and 10 in different colours. Add case statements and
numbers as appropriate.

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

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

Hi Graham,

Thanks for replying

I got this error when I tried to run to the macro

Run time error 5941
The requested member of the selection does not exist

And its pointing to this line. Set oCell = .Cell(i,
j).Range

 

[simmo]

That should all be on one line

Set oCell = .Cell(i, j).Range

--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP







Hi Graham,

Thanks for replying

 I got this error when I tried to run to the macro

Run time error 5941
The requested member of the selection does not exist

And its pointing to this line.            Set oCell = .Cell(i,
j).Range- Hide quoted text -

- Show quoted text -

Hi Graham,

Thanks for your time

The above text was all on one line, it was my error when pasting it,
sorry about that

I have copied the code out of the visual basic window
My aim is to get it to search all tables in the doc if that makes any
difference

The error message im getting is

Run time error 5941
The requested member of the selection does not exist


Sub HiLightNumbers1()
Dim oCell As Range
With ActiveDocument.Tables(1)
For i = 1 To .Rows.Count
For j = 1 To .Columns.Count
Set oCell = .Cell(i, j).Range The error
points to this line
oCell.End = oCell.End - 1
Select Case oCell.Text
Case Is = "14"
oCell.HighlightColorIndex = wdYellow
Case Is = "12"
oCell.HighlightColorIndex = wdPink
Case Is = "10"
oCell.HighlightColorIndex = wdTeal
Case Else
oCell.HighlightColorIndex = wdNoHighlight
End Select
Next j
Next i
End With
End Sub

 

[Graham Mayor]

The implication of the message is that you have merged cells in table 1. To
make that macro work (assuming no merged cells) across multipe tables you
need

Sub HiLightNumbers()
Dim oCell As Range
For h = 1 To ActiveDocument.Tables.Count
With ActiveDocument.Tables(h)
For i = 1 To .Rows.Count
For j = 1 To .Columns.Count
Set oCell = .Cell(i, j).Range
oCell.End = oCell.End - 1
Select Case oCell.Text
Case Is = "14"
oCell.HighlightColorIndex = wdYellow
Case Is = "12"
oCell.HighlightColorIndex = wdPink
Case Is = "10"
oCell.HighlightColorIndex = wdTeal
Case Else
oCell.HighlightColorIndex = wdNoHighlight
End Select
Next j
Next i
End With
Next h
End Sub

However if you have merged cells and wish to avoid the error message. you
need a variation on Helmut's approach e.g.

Sub HiLightNumbers()
Dim rDcm As Range
Dim vFindText As Variant
vFindText = Array("10", "12", "14")
For i = LBound(vFindText) To UBound(vFindText)
With Selection
.HomeKey wdStory
With .Find
.Text = vFindText(i)
While .Execute
Set rDcm = Selection.Range
If rDcm.Information(wdWithInTable) Then
If Len(rDcm.Cells(1).Range) = 4 Then
If i = 0 Then rDcm.HighlightColorIndex = wdYellow
If i = 1 Then rDcm.HighlightColorIndex = wdPink
If i = 2 Then rDcm.HighlightColorIndex = wdTeal
End If
End If
Wend
End With
End With
Next i
End Sub

The numbers to find are in the array, counted from left to right starting at
0
I have simply set the conditional fields to match the number order with
colours

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


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

 

[Helmut Weber]

Hi Simmo,

maybe something like that:

Sub TestaaB()
Dim rDcm As Range
Dim sTmp As String
start:
Set rDcm = ActiveDocument.Range
sTmp = InputBox("Your number?")
If sTmp = "" Then Exit Sub
With rDcm.Find
.Text = sTmp
While .Execute
If rDcm.Information(wdWithInTable) Then
If Len(rDcm.Cells(1).Range) = 4 Then
rDcm.HighlightColorIndex = wdYellow
' and more formatting, just as you like
End If
End If
Wend
End With
GoTo start:
End Sub

which could become kind of complicated
for a beginner when driving for perfection.


--

Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Vista Small Business, Office XP

 

[Helmut Weber]

hmm...

my former post was restricted to numbers of a length of 2.
Note the indicated line to make it work for numbers of any length.

Sub TestaaBx()
Dim rDcm As Range
Dim sTmp As String
start:
Set rDcm = ActiveDocument.Range
sTmp = InputBox("Your number?")
If sTmp = "" Then Exit Sub
With rDcm.Find
.Text = sTmp
While .Execute
If rDcm.Information(wdWithInTable) Then
' ***************
If Len(rDcm.Cells(1).Range) = Len(sTmp) + 2 Then
' ***************
rDcm.HighlightColorIndex = wdYellow
' and more formatting, just as you like
End If
End If
Wend
End With
GoTo start:
End Sub

--

Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Vista Small Business, Office XP

 

[simmo]

hmm...

my former post was restricted to numbers of a length of 2.
Note the indicated line to make it work for numbers of any length.

Sub TestaaBx()
Dim rDcm As Range
Dim sTmp As String
start:
Set rDcm = ActiveDocument.Range
sTmp = InputBox("Your number?")
If sTmp = "" Then Exit Sub
With rDcm.Find
   .Text = sTmp
   While .Execute
      If rDcm.Information(wdWithInTable) Then
      ' ***************
         If Len(rDcm.Cells(1).Range) = Len(sTmp) + 2 Then
      ' ***************
            rDcm.HighlightColorIndex = wdYellow
            ' and more formatting, just as you like
         End If
      End If
   Wend
End With
GoTo start:
End Sub

--

Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Vista Small Business, Office XP

Thank you both for your help

 

[fumei via OfficeKB.com]

I do not understand the use of the counters of Rows and Columns, nor the
check for wdWithinTable. Using the Range of the entire document means
searching through everything. Why not just search through tables...since
that is what is wanted?

Further, by using the table range, you can use its .Cells collection, and it
works fine with merged cells.

The Function simply makes sure you are working with just text, not the end-of-
cell markers.

Function CellText2(aCell As Cell) As String
Dim sText As String
sText = aCell.Range.Text
CellText2 = Left(sText, Len(sText) - 2)
End Function


Sub HighlightCells()
Dim oTable As Table
Dim oCell As Cell
For Each oTable In ActiveDocument.Tables
For Each oCell In oTable.Range.Cells
Select Case CellText2(oCell)
Case 14
oCell.Range.HighlightColorIndex = wdYellow
Case 12
oCell.Range.HighlightColorIndex = wdPink
Case 10
oCell.Range.HighlightColorIndex = wdTeal
End Select
Next
Next
End Sub

That just checks tables - the rest of the document is ignored.

Only does something if the text is 14, 12, or 10.

Is not affected by merged cells, as merged cells are singular items in the
Table.Range.Cells collection.