Diaa
Diaa

Reputation: 135

Find each table whose first cell has one of two words followed by three digits

I would like to fix the following code to make it find each table in the document where it has the pattern ARC or MEC words followed by the wildcard digits [1-4][1-9]{2} without any leading/trailing characters, digits, spaces, etc.

The chosen table should have a total of 11 rows.

If possible, I need another version of the code to search for the pattern in the table first cell .Cell(1,1) while making sure the table has a total of 11 rows.

Sub FindTables()
    
    Dim wdDoc As Word.Document, t As Long
    Set wdDoc = ThisDocument
    
    With wdDoc
        
        For t = 1 To .Tables.Count
            
            With .Tables(t).Range.Find

                .ClearFormatting
                .Format = FALSE
                .Text = "(ARC)|(MEC)[1-4][1-9]{2}"
                .Forward = TRUE
                .Wrap = wdFindStop
                .MatchCase = TRUE
                .MatchWildcards = TRUE
                .Execute
                
                If .Found = TRUE Then
                    ' some operations on the table
                    wdDoc.Tables(t).AutoFitBehavior (wdAutoFitWindow)
                    wdDoc.Tables(t).Range.Collapse wdCollapseEnd
                End If
                
            End With
            
        Next
        
    End With
    
End Sub

Upvotes: 0

Views: 59

Answers (2)

ALeXceL
ALeXceL

Reputation: 651

Pattern:

"(ARC[1-4][1-9]{2})|(MEC[1-4][1-9]{2})"

Tested successfully with Microsoft VbScript Regular Expressions 5.5. (set this Reference on VBE).

Code sample - adapt it to suit your needs (working with tables - I didn't reproduce your scenario):

Function fnFindPatterns()
    Dim objRegExp As RegExp
    Dim ObjMatch As Match
    Dim colMatches As MatchCollection
    Dim strText As String
    Dim strResult As String

    Set objRegExp = New RegExp
    objRegExp.Pattern = "(ARC[1-4][1-9]{2})|(MEC[1-4][1-9]{2})"
    objRegExp.IgnoreCase = True
    objRegExp.Global = True

    Selection.WholeStory
    strText = Selection.Text

    If objRegExp.Test(strText) = True Then 'we have something there...
        Set colMatches = objRegExp.Execute(strText)
        For Each ObjMatch In colMatches  'Iterate on the collection
            strResult = strResult & ObjMatch.Value & vbCrLf
        Next
    Else
    End If

    MsgBox strResult

End Function

Edited 2022 07 11:

I realized that the "|" (OR) do not work in MSWord . It doesn't exist on the limited "Regular Expressions" set of tools within MsWord, compared to VbScript.RegExp. Wich, in turn, is also limited set of tools, if compared with other (powerfull) programming languages. But with some coding we "simulate" this OR, using "Choose", testing each partial set of patterns that way:

Sub FindTables()
    Dim wdDoc As Word.Document, t As Long, intChoose As Integer
    Set wdDoc = ThisDocument
    
    With wdDoc
        For intChoose = 1 To 2
            For t = 1 To .Tables.Count
                With .Tables(t).Range.Find
                    .ClearFormatting
                    .Format = False
                    .Text = VBA.Choose(intChoose, "<[ARC]{3}[1-4][1-9]{2}>", "<(MEC)[1-4][1-9]{2}>")
                    .Forward = True
                    .Wrap = wdFindStop
                    .MatchCase = True
                    .MatchWildcards = True
                    .Execute
                
                    If .Found = True Then
                        ' some operations on the table
                        wdDoc.Tables(t).AutoFitBehavior (wdAutoFitWindow)
                        wdDoc.Tables(t).Range.Collapse wdCollapseEnd
                    End If
                    
                End With
            Next
        Next
    End With
End Sub

To test this code I mounted a Word Doc with 7 tables (varying dimensions from 1 x 11 to 1 x 13). To ensure the correct dimension of each table insert the suggestion posted in Macropod's code.

Upvotes: 1

macropod
macropod

Reputation: 13515

For example:

Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Format = False
    .Forward = True
    .Wrap = wdFindStop
    .MatchWildcards = True
    .Text = "<[ACEMR]{3}[1-4][1-9]{2}>"
    .Replacement.Text = ""
  End With
  Do While .Find.Execute = True
   If .Information(wdWithInTable) = True Then
    If .Tables(1).Rows.Count = 11 Then
      'If .Cells(1).RowIndex = 1 And .Cells(1).ColumnIndex = 1 Then
        If Split(.Cells(1).Range.Text, vbCr)(0) = .Text Then
          Select Case Left(.Text, 3)
            Case "ARC", "MEC":  .Tables(1).AutoFitBehavior (wdAutoFitWindow)
          End Select
        End If
      'End If
    End If
    .Start = .Tables(1).Range.End
   End If
   .Collapse wdCollapseEnd
  Loop
End With
Application.ScreenUpdating = True
End Sub

To process only those tables where the found content is in the first cell, delete the tick marks from the two comment-out lines.

Upvotes: 1

Related Questions