RegExp?

[matthewspatrick]

Malcolm,


Ask, and ye shall receive. Add this code to a module in the document, and run the macro CheckTags. It will summarize the tags, and show the number of opens and closes for each tag. It will also mark "unbalanced" tag names with asterisks.

Patrick

 Option Explicit 
Function RegExpFind(LookIn As String, PatternStr As String, Optional Pos)
    ' This function uses Regular Expressions to parse a string (LookIn), 
    'and return matches to a pattern (PatternStr). Use Pos to indicate which match you want:
    ' Pos omitted : function returns a zero-based array of all matches
    ' Pos = 0 : the last match
    ' Pos = 1 : the first match
    ' Pos = 2 : the second match
    ' Pos = <positive integer> : the Nth match
    ' If Pos is greater than the number of matches, is negative, or is 
    'non-numeric, the function returns an empty string. If no match is found, the function returns an empty string.  
    ' If you use this function in Excel, you can use range references for any of the arguments.
    ' If you use this in Excel and return the full array, make sure to setup the formula as an array formula. _
    If you need the array formula 'to go down a column, use TRANSPOSE()
 
    Dim re As Object
    Dim TheMatches As Object
    Dim Answer() As String
    Dim Counter As Long
    ' Evaluate Pos. If it is there, it must be numeric and converted to Long
    If Not IsMissing(Pos) Then
        If Not IsNumeric(Pos) Then
            RegExpFind = ""
            Exit Function
        Else
            Pos = CLng(Pos)
        End If
    End If
    ' Create instance of RegExp object
    Set re = CreateObject("VBScript.RegExp")
    With re
        .Pattern = PatternStr
        .Global = True
    End With
    ' Test to see if there are any matches
    If re.test(LookIn) Then
        ' Run RegExp to get the matches, which are returned as a zero-based collection
        Set TheMatches = re.Execute(LookIn)
        ' If Pos is missing, user wants array of all matches. Build it and assign it as the function's return value
        If IsMissing(Pos) Then
            ReDim Answer(0 To TheMatches.Count - 1) As String
            For Counter = 0 To UBound(Answer)
                Answer(Counter) = TheMatches(Counter)
            Next
                RegExpFind = Answer
                ' User wanted the Nth match (or last match, if Pos = 0). Get the Nth 'value, if possible
            Else
                Select Case Pos
                    Case 0 ' Last match
                        RegExpFind = TheMatches(TheMatches.Count - 1)
                    Case 1 To TheMatches.Count ' Nth match
                        RegExpFind = TheMatches(Pos - 1)
                    Case Else ' Invalid item number
                        RegExpFind = ""
                End Select
            End If
        ' If there are no matches, return empty string
        Else
            RegExpFind = ""
        End If
        ' Release object variables
        Set re = Nothing
        Set TheMatches = Nothing
End Function

Sub CheckTags()
    Dim dic As Object
    Dim arr As Variant
    Dim TheString As String
    Dim Counter As Long
    Dim KeyName As String
    Dim EndTag As Boolean
    Dim ValueArr(1 To 2) As Long
    Selection.Expand wdStory
    TheString = Selection.Text
    arr = RegExpFind(TheString, "</{0,1}[a-zA-Z]*>")
    Set dic = CreateObject("Scripting.Dictionary")
    For Counter = 0 To UBound(arr)
        If InStr(1, arr(Counter), "/") > 0 Then EndTag = True Else EndTag = False
        KeyName = Replace(arr(Counter), "/", "")
        If dic.Exists(KeyName) Then
            ValueArr(1) = Val(Split(dic.Item(KeyName), "|")(0)) + IIf(EndTag, 0, 1)
            ValueArr(2) = Val(Split(dic.Item(KeyName), "|")(1)) + IIf(EndTag, 1, 0)
            dic.Item(KeyName) = ValueArr(1) & "|" & ValueArr(2)
        Else
            dic.Add KeyName, IIf(EndTag, "0|1", "1|0")
       End If
    Next
    arr = dic.Keys
    TheString = ""
    For Counter = 0 To UBound(arr)
        TheString = TheString & arr(Counter) & ": " & dic.Item(arr(Counter)) & _
        IIf(Split(dic.Item(arr(Counter)), "|")(0) <> Split(dic.Item(arr(Counter)), "|")(1), _
        " ****", "") & Chr(10)
    Next
    TheString = Left(TheString, Len(TheString) - 1)
    MsgBox TheString, vbOKOnly, "RegExp saves the day!"
    Set dic = Nothing
End Sub