Sub QuotesCheck() ' ' QuotesCheck Macro Dim WorkPara As String Dim CheckP() As Boolean Dim NumPara As Integer, J As Integer Dim LeftParens As Integer, RightParens As Integer Dim MsgText As String Dim OpenChar As String Dim CloseChar As String OpenChar = ChrW(8220) CloseChar = ChrW(8221) MsgText = "***Unbalanced quotes in previous paragraphs*** " NumPara = ActiveDocument.Paragraphs.Count ReDim CheckP(NumPara) For J = 1 To NumPara CheckP(J) = False WorkPara = ActiveDocument.Paragraphs(J).Range.Text If Len(WorkPara) <> 0 Then LeftParens = CountChars(WorkPara, OpenChar) RightParens = CountChars(WorkPara, CloseChar) If LeftParens <> RightParens Then CheckP(J) = True End If Next J For J = NumPara To 1 Step -1 If CheckP(J) Then Selection.HomeKey Unit:=wdStory, Extend:=wdMove If J > 1 Then Selection.MoveDown Unit:=wdParagraph, _ Count:=(J - 1), Extend:=wdMove End If Selection.InsertParagraphBefore Selection.MoveLeft Unit:=wdCharacter, Count:=1 Selection.Style = "Normal" Selection.Range.HighlightColorIndex = wdYellow Selection.TypeText Text:=MsgText Selection.TypeText Text:=(J - 1) End If Next J End Sub Private Function CountChars(A As String, C As String) As Integer Dim Count As Integer Dim Found As Integer Count = 0 Found = InStr(A, C) While Found <> 0 Count = Count + 1 Found = InStr(Found + 1, A, C) Wend CountChars = Count End Function Sub F7DropCap() ' ' F7DropCap Macro ' ' Selection.MoveRight Unit:=wdCharacter, Count:=1 Selection.Delete Unit:=wdCharacter, Count:=1 Selection.MoveLeft Unit:=wdCharacter, Count:=1 Selection.Style = ActiveDocument.Styles("NormalFirstParagraph") With Selection.Paragraphs(1).DropCap .Position = wdDropNormal .FontName = "Palatino Linotype" .LinesToDrop = 3 .DistanceFromText = InchesToPoints(0) End With End Sub