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 set
'up 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