Question : Conditional message for MsgBox

Dear Experts:

below macro, courtesy by 'wobbled' from EE, lists the number of columns and manual column breaks per section, such as:

Section 1: Columns 2 - Column breaks (1)
Section 3: Columns 1 - Column breaks (0)
Section 4: Columns 2 - Column breaks (1)
etc.

I would like below MsgBox to show me only sections where column breaks have been found and omit the ones where no column breaks have been detected.

Help is much appreciated.

Thank you very much in advance.

Regards, Andreas
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
Sub ShowColumnInfo()

Dim doc As Document
Dim i As Integer
Dim Sec As Section
Dim str As String, strColBk As String

    Set doc = ActiveDocument
    
    
    For Each Sec In doc.Sections
        i = i + 1
        strColBk = CountWordPhrase(i, doc)
        str = str & vbCrLf & "Section: " & i & " Columns " & Sec.PageSetup.TextColumns.Count & "- " & "ColumnBreaks (" & strColBk & "), "
    Next

    MsgBox "Column Break Info:" & str, vbInformation, "Column break info per section"
    

End Sub

Private Function CountWordPhrase(SecId As Integer, myDoc As Document) As String

Dim x As String
Dim y As Integer

    On Error Resume Next  'not really recommended but problems can happen on finds

    x = "^n"  'column break text
   
    myDoc.Sections(SecId).Range.Select
    With Selection.Find
        Do While .Execute(FindText:=x, Forward:=True, Format:=True, _
           MatchWholeWord:=True) = True
           y = y + 1
        Loop
    End With

    CountWordPhrase = CStr(y)

End Function

Answer : Conditional message for MsgBox

Try this:
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
Sub ShowColumnInfo()
 
Dim doc As Document
Dim i As Integer
Dim Sec As Section
Dim str As String, strColBk As String
 
    Set doc = ActiveDocument
     
     
    For Each Sec In doc.Sections
        i = i + 1
        If (CInt(CountWordPhrase(i, doc)) > 0) Then
            strColBk = CountWordPhrase(i, doc)
            str = str & vbCrLf & "Section: " & i & " Columns " & Sec.PageSetup.TextColumns.Count & "- " & "ColumnBreaks (" & strColBk & "), "
        End If
    Next
 
    MsgBox "Column Break Info:" & str, vbInformation, "Column break info per section"
     
 
End Sub
 
Private Function CountWordPhrase(SecId As Integer, myDoc As Document) As String
 
Dim x As String
Dim y As Integer
 
    On Error Resume Next  'not really recommended but problems can happen on finds
 
    x = "^n"  'column break text
    
    myDoc.Sections(SecId).Range.Select
    With Selection.Find
        Do While .Execute(FindText:=x, Forward:=True, Format:=True, _
           MatchWholeWord:=True) = True
           y = y + 1
        Loop
    End With
 
    CountWordPhrase = CStr(y)
 
End Function
Random Solutions  
 
programming4us programming4us