Printing List of Content Control Text

[tgamekh]

Hi!

I am a newer to VBA and I am working on a Word project where I have multiple content controls which are titled and tagged. For instance:

Procedure (Title: Procedure, Tag: 1.1) Rich Text
Findings (Title: Findings, Tag: 1.1) Rich Text
Priority (Title: Priority, Tag: 1.1) Drop Down List
Recommendation (Title: Recommendation, Tag: 1.1) Rich Text


Procedure (Title: Procedure, Tag: 1.2) Rich Text
Findings (Title: Findings, Tag: 1.2) Rich Text
Priority (Title: Priority, Tag: 1.2) Drop Down List
Recommendation (Title: Recommendation, Tag: 1.2) Rich Text

I am trying to print a list of the text in the content controls when the following criteria is met:
Priority is not "N/A"
Group and list by Priority value (Comment, Low, Moderate, High, Finding)
Procedure - Recommendation (where the procedure and recommendation have the same tag)

Currently, I have been working on the following which is basic, but does print the Recommendations that are populated to a new word document in a list. I am having an issue getting the correlation to combine the procedure and recommendation by tag and then list them grouped by priority. Thoughts on the complexity of this task?

Current code:
Sub GetCCTags()
Dim i As Long, ReccOut As String

Dim Index As String
With ActiveDocument

For i = 1 To .ContentControls.Count
If .ContentControls(i).Title = "Reccomendation" Then
ReccOut = ReccOut & vbCr & .ContentControls(i).Range.Text

End If

Next

End With
ReccOut = ReccOut

Documents.Add
ActiveDocument.Range.Text = ReccOut

End Sub

[macropod]

Without access to a document showing where these content controls are in relation to each other, it's impossible to provide specific advice on the code you need. Can you attach a document to a post with some representative data (delete anything sensitive)? You do this via the paperclip symbol on the 'Go Advanced' tab at the bottom of this screen.

[tgamekh]

My apologies macropod and thank you for asking for the example, which is attached and is a template with example content controls formatted and tagged.

Ultimately I am trying to get a list printed to the new document which shows the following titles where the tags are the same, and then grouped by priority in the list:

Procedure - Recommendation

Thoughts?

[gmayor]

You haven't made it easier by using common names and tags throughout. It would have been preferable to have used unique titles and tags, however it can be done despite the confusion caused by your spelling of 'Recommendation' in the titles. If the content controls titles are spelled correctly in the live document, you will need to modify the code

If oCC2.Title = "Reccomendation" And oCC2.Tag = .ContentControls(i).Tag Then

to reflect the correct spelling of Recommendation.

Note the code goes in a normal module and not the ThisDocument module.

Option Explicit

Sub GetCCTags()
Dim i As Long
Dim oCC As ContentControl, oCC2 As ContentControl
Dim cComment As Collection
Dim cLow As Collection
Dim cModerate As Collection
Dim cHigh As Collection
Dim cFinding As Collection
Dim strRecommendation As String
Dim oSource As Document
Dim oDoc As Document
Dim oRng As Range

    Set cComment = New Collection
    Set cLow = New Collection
    Set cModerate = New Collection
    Set cHigh = New Collection
    Set cFinding = New Collection

    Set oSource = ActiveDocument

    With oSource
        For i = 1 To .ContentControls.Count
            If .ContentControls(i).Title = "Priority" Then
                For Each oCC In oSource.ContentControls
                    strRecommendation = ""
                    If oCC.Title = "Procedure" And oCC.Tag = .ContentControls(i).Tag Then
                        strRecommendation = oCC.Range.Text
                        For Each oCC2 In oSource.ContentControls
                            If oCC2.Title = "Reccomendation" And oCC2.Tag = .ContentControls(i).Tag Then
                                strRecommendation = strRecommendation & vbTab & "-" & Chr(9) & oCC2.Range.Text
                                Exit For
                            End If
                        Next oCC2
                        Exit For
                    End If
                Next oCC
                Select Case .ContentControls.Item(i).Range.Text
                    Case "Comment": cComment.Add strRecommendation
                    Case "Low": cLow.Add strRecommendation
                    Case "Moderate": cModerate.Add strRecommendation
                    Case "High": cHigh.Add strRecommendation
                    Case "Finding": cFinding.Add strRecommendation
                End Select
            End If
        Next i
    End With
    Set oDoc = Documents.Add
    If cComment.Count > 0 Then
        Set oRng = oDoc.Range
        oRng.Collapse 0
        oRng.Text = "Comment"
        oRng.Style = "Heading 1"
        oRng.InsertParagraphAfter
        oRng.End = oDoc.Range.End
        oRng.Collapse 0
        oRng.Style = "Normal"
        For i = 1 To cComment.Count
            oRng.Text = cComment(i) & vbCr
            oRng.Collapse 0
        Next i
    End If
    If cLow.Count > 0 Then
        Set oRng = oDoc.Range
        oRng.Collapse 0
        oRng.Text = "Low"
        oRng.Style = "Heading 1"
        oRng.InsertParagraphAfter
        oRng.End = oDoc.Range.End
        oRng.Collapse 0
        oRng.Style = "Normal"
        For i = 1 To cLow.Count
            oRng.Text = cLow(i) & vbCr
            oRng.Collapse 0
        Next i
    End If
    If cModerate.Count > 0 Then
        Set oRng = oDoc.Range
        oRng.Collapse 0
        oRng.Text = "Moderate"
        oRng.Style = "Heading 1"
        oRng.InsertParagraphAfter
        oRng.End = oDoc.Range.End
        oRng.Collapse 0
        oRng.Style = "Normal"
        For i = 1 To cModerate.Count
            oRng.Text = cModerate(i) & vbCr
            oRng.Collapse 0
        Next i
    End If
    If cHigh.Count > 0 Then
        Set oRng = oDoc.Range
        oRng.Collapse 0
        oRng.Text = "High"
        oRng.Style = "Heading 1"
        oRng.InsertParagraphAfter
        oRng.End = oDoc.Range.End
        oRng.Collapse 0
        oRng.Style = "Normal"
        For i = 1 To cHigh.Count
            oRng.Text = cHigh(i) & vbCr
            oRng.Collapse 0
        Next i
    End If
    If cFinding.Count > 0 Then
        Set oRng = oDoc.Range
        oRng.Collapse 0
        oRng.Text = "Finding"
        oRng.Style = "Heading 1"
        oRng.InsertParagraphAfter
        oRng.End = oDoc.Range.End
        oRng.Collapse 0
        oRng.Style = "Normal"
        For i = 1 To cFinding.Count
            oRng.Text = cFinding(i) & vbCr
            oRng.Collapse 0
        Next i
    End If
lbl_exit:
    Set oDoc = Nothing
    Set oRng = Nothing
    Set oCC = Nothing
    Set cComment = Nothing
    Set cLow = Nothing
    Set cModerate = Nothing
    Set cHigh = Nothing
    Set cFinding = Nothing
    Exit Sub
End Sub

[tgamekh]

You haven't made it easier by using common names and tags throughout. It would have been preferable to have used unique titles and tags, however it can be done despite the confusion caused by your spelling of 'Recommendation' in the titles. If the content controls titles are spelled correctly in the live document, you will need to modify the code

If oCC2.Title = "Reccomendation" And oCC2.Tag = .ContentControls(i).Tag Then

to reflect the correct spelling of Recommendation.

Note the code goes in a normal module and not the ThisDocument module.

Gmayor,

Duly noted about the misspelling. It will take me a little while to go through to understand the details. I appreciate the time you put into this. One question that I do have is in regards to your last statement. Am I correct in my assessment that since this would be a template doc, inserting the code into ThisDocument would only allow it to run if I am using the document with the code; however, by putting it in the normal module would allow it to be access and run across multiple documents without inserting the code into each one?

[gmayor]

If the document is to be used as a template then save it as a macro enabled template and create new documents from it.
The ThisDocument module is a particular type of class module primarily aimed at events programming.
Use an ordinary module for this code.
ThisDocument is the document or template containing the code that is running.
ActiveDocument is the currently active document.

The code I posted uses a Collection for each of the values in the 'Priority' Dropdown, which stores the values associated with that Dropdown value.
It looks at each 'Priority' Dropdown in turn and then adds the associated values to the appropriate Collection.

The collection values are them added to the log document in turn with appropriate headings.

[gmaxey]

Graham,

You can save a little looping by leveraging the SelectContentControlsByTitle collections:

Sub GetCCTags()
Dim i As Long
Dim oCCPri As ContentControls, oCCPro As ContentControls, oCCRec As ContentControls
Dim oCC1 As ContentControl, oCC2 As ContentControl, OCC3
Dim cComment As Collection
Dim cLow As Collection
Dim cModerate As Collection
Dim cHigh As Collection
Dim cFinding As Collection
Dim strRecommendation As String
Dim oSource As Document
Dim oDoc As Document
Dim oRng As Range
  Set cComment = New Collection
  Set cLow = New Collection
  Set cModerate = New Collection
  Set cHigh = New Collection
  Set cFinding = New Collection
  Set oSource = ActiveDocument
  With oSource
    Set oCCPri = .SelectContentControlsByTitle("Priority")
    Set oCCPro = .SelectContentControlsByTitle("Procedure")
    Set oCCRec = .SelectContentControlsByTitle("Recommendation")
    For Each oCC1 In oCCPri
      For Each oCC2 In oCCPro
        strRecommendation = ""
        If oCC2.Tag = oCC1.Tag Then
          strRecommendation = oCC2.Range.Text
          For Each OCC3 In oCCRec
            If OCC3.Tag = oCC1.Tag Then
              strRecommendation = strRecommendation & vbTab & "-" & Chr(9) & OCC3.Range.Text
              Exit For
            End If
          Next OCC3
          Exit For
        End If
      Next oCC2
      Select Case oCC1.Range.Text
        Case "Comment": cComment.Add strRecommendation
        Case "Low": cLow.Add strRecommendation
        Case "Moderate": cModerate.Add strRecommendation
        Case "High": cHigh.Add strRecommendation
        Case "Finding": cFinding.Add strRecommendation
      End Select
      Next oCC1
  End With
  Set oDoc = Documents.Add
  If cComment.Count > 0 Then
    Set oRng = oDoc.Range
    oRng.Collapse 0
    oRng.Text = "Comment"
    oRng.Style = "Heading 1"
    oRng.InsertParagraphAfter
    oRng.End = oDoc.Range.End
    oRng.Collapse 0
    oRng.Style = "Normal"
    For i = 1 To cComment.Count
      oRng.Text = cComment(i) & vbCr
      oRng.Collapse 0
    Next i
  End If
  If cLow.Count > 0 Then
    Set oRng = oDoc.Range
    oRng.Collapse 0
    oRng.Text = "Low"
    oRng.Style = "Heading 1"
    oRng.InsertParagraphAfter
    oRng.End = oDoc.Range.End
    oRng.Collapse 0
    oRng.Style = "Normal"
    For i = 1 To cLow.Count
      oRng.Text = cLow(i) & vbCr
      oRng.Collapse 0
    Next i
  End If
  If cModerate.Count > 0 Then
    Set oRng = oDoc.Range
    oRng.Collapse 0
    oRng.Text = "Moderate"
    oRng.Style = "Heading 1"
    oRng.InsertParagraphAfter
    oRng.End = oDoc.Range.End
    oRng.Collapse 0
    oRng.Style = "Normal"
    For i = 1 To cModerate.Count
      oRng.Text = cModerate(i) & vbCr
      oRng.Collapse 0
    Next i
  End If
  If cHigh.Count > 0 Then
    Set oRng = oDoc.Range
    oRng.Collapse 0
    oRng.Text = "High"
    oRng.Style = "Heading 1"
    oRng.InsertParagraphAfter
    oRng.End = oDoc.Range.End
    oRng.Collapse 0
    oRng.Style = "Normal"
    For i = 1 To cHigh.Count
      oRng.Text = cHigh(i) & vbCr
      oRng.Collapse 0
    Next i
  End If
  If cFinding.Count > 0 Then
    Set oRng = oDoc.Range
    oRng.Collapse 0
    oRng.Text = "Finding"
    oRng.Style = "Heading 1"
    oRng.InsertParagraphAfter
    oRng.End = oDoc.Range.End
    oRng.Collapse 0
    oRng.Style = "Normal"
    For i = 1 To cFinding.Count
      oRng.Text = cFinding(i) & vbCr
      oRng.Collapse 0
    Next i
  End If
lbl_exit:
  Set oSource = Nothing: Set oDoc = Nothing
  Set oRng = Nothing
  Set oCCPri = Nothing: Set oCCPro = Nothing: Set oCCRec = Nothing:
  Set oCC1 = Nothing: Set oCC2 = Nothing: Set OCC3 = Nothing
  Set cComment = Nothing
  Set cLow = Nothing
  Set cModerate = Nothing
  Set cHigh = Nothing
  Set cFinding = Nothing
  Exit Sub
End Sub

[tgamekh]

Graham,

My reasoning for using common names and tags was not specific to this particular code, but rather attempting to thing ahead and be able to use the common elements for other routines. Perhaps I was thinking too hard or did something where nothing was needed.

I am still looking through the code you put together to understand how some of it is working, nonetheless, the code works flawlessly. Thank you

[macropod]

If your content controls had been inserted in a consistent order, you could have used something like:

Sub Demo()
Application.ScreenUpdating = False
Dim i As Long, StrOut As String, wdDoc As Document
StrOut = "Procedure" & vbTab & "Findings" & vbTab & "Priority" & vbTab & "Recommendation" & vbCr
With ActiveDocument
  For i = 1 To .SelectContentControlsByTitle("Priority").Count
    If .SelectContentControlsByTitle("Priority")(i).Range.Text <> "N/A" Then
      StrOut = StrOut & .SelectContentControlsByTitle("Procedure")(i).Range.Text & vbTab
      StrOut = StrOut & .SelectContentControlsByTitle("Finding")(i).Range.Text & vbTab
      StrOut = StrOut & .SelectContentControlsByTitle("Priority")(i).Range.Text & vbTab
      StrOut = StrOut & .SelectContentControlsByTitle("Reccomendation")(i).Range.Text & vbCr
    End If
  Next
End With
Set wdDoc = Documents.Add
With wdDoc.Range
  .Text = StrOut
  .ConvertToTable
  With .Tables(1)
    .Rows(1).HeadingFormat = True
    .Rows(1).Range.Font.Bold = True
    .Sort ExcludeHeader:=True, FieldNumber:=3, SortFieldType:=wdSortFieldAlphanumeric, SortOrder:=wdSortOrderAscending
  End With
End With
Application.ScreenUpdating = True
End Sub

As it is, however, your first "Procedure" is actually 'Test 3', the first "Finding" relates to procedure 4, and the first "Reccomendation" relates to procedure 2, etc. ...

[tgamekh]

If your content controls had been inserted in a consistent order, you could have used something like:

Sub Demo()
Application.ScreenUpdating = False
Dim i As Long, StrOut As String, wdDoc As Document
StrOut = "Procedure" & vbTab & "Findings" & vbTab & "Priority" & vbTab & "Recommendation" & vbCr
With ActiveDocument
  For i = 1 To .SelectContentControlsByTitle("Priority").Count
    If .SelectContentControlsByTitle("Priority")(i).Range.Text <> "N/A" Then
      StrOut = StrOut & .SelectContentControlsByTitle("Procedure")(i).Range.Text & vbTab
      StrOut = StrOut & .SelectContentControlsByTitle("Finding")(i).Range.Text & vbTab
      StrOut = StrOut & .SelectContentControlsByTitle("Priority")(i).Range.Text & vbTab
      StrOut = StrOut & .SelectContentControlsByTitle("Reccomendation")(i).Range.Text & vbCr
    End If
  Next
End With
Set wdDoc = Documents.Add
With wdDoc.Range
  .Text = StrOut
  .ConvertToTable
  With .Tables(1)
    .Rows(1).HeadingFormat = True
    .Rows(1).Range.Font.Bold = True
    .Sort ExcludeHeader:=True, FieldNumber:=3, SortFieldType:=wdSortFieldAlphanumeric, SortOrder:=wdSortOrderAscending
  End With
End With
Application.ScreenUpdating = True
End Sub

As it is, however, your first "Procedure" is actually 'Test 3', the first "Finding" relates to procedure 4, and the first "Reccomendation" relates to procedure 2, etc. ...

Understood. Out of curiosity, is there a way to do this without the use of the content controls with tags? Just wondering if I took a trip down this path when a shorter, more efficient route was possible.

[macropod]

Yes, you could use code like:

Sub Demo()
Application.ScreenUpdating = False
Dim i As Long, StrOut As String, wdDoc As Document
StrOut = "Procedure" & vbTab & "Findings" & vbTab & "Priority" & vbTab & "Recommendation" & vbCr
With ActiveDocument
  For i = 1 To .ContentControls.Count Step 4
    If .ContentControls(i + 2).Range.Text <> "N/A" Then
      StrOut = StrOut & .ContentControls(i).Range.Text & vbTab
      StrOut = StrOut & .ContentControls(i + 1).Range.Text & vbTab
      StrOut = StrOut & .ContentControls(i + 2).Range.Text & vbTab
      StrOut = StrOut & .ContentControls(i + 3).Range.Text & vbCr
    End If
  Next
End With
Set wdDoc = Documents.Add
With wdDoc.Range
  .Text = StrOut
  .ConvertToTable
  With .Tables(1)
    .Rows(1).HeadingFormat = True
    .Rows(1).Range.Font.Bold = True
    .Sort ExcludeHeader:=True, FieldNumber:=3, SortFieldType:=wdSortFieldAlphanumeric, SortOrder:=wdSortOrderAscending
  End With
End With
Application.ScreenUpdating = True
End Sub

but that's not materially shorter. It also relies on your document having no other content controls, though additional code could be used to work around that - which would make the code longer...

[tgamekh]

Yes, you could use code like:

Sub Demo()
Application.ScreenUpdating = False
Dim i As Long, StrOut As String, wdDoc As Document
StrOut = "Procedure" & vbTab & "Findings" & vbTab & "Priority" & vbTab & "Recommendation" & vbCr
With ActiveDocument
  For i = 1 To .ContentControls.Count Step 4
    If .ContentControls(i + 2).Range.Text <> "N/A" Then
      StrOut = StrOut & .ContentControls(i).Range.Text & vbTab
      StrOut = StrOut & .ContentControls(i + 1).Range.Text & vbTab
      StrOut = StrOut & .ContentControls(i + 2).Range.Text & vbTab
      StrOut = StrOut & .ContentControls(i + 3).Range.Text & vbCr
    End If
  Next
End With
Set wdDoc = Documents.Add
With wdDoc.Range
  .Text = StrOut
  .ConvertToTable
  With .Tables(1)
    .Rows(1).HeadingFormat = True
    .Rows(1).Range.Font.Bold = True
    .Sort ExcludeHeader:=True, FieldNumber:=3, SortFieldType:=wdSortFieldAlphanumeric, SortOrder:=wdSortOrderAscending
  End With
End With
Application.ScreenUpdating = True
End Sub

but that's not materially shorter. It also relies on your document having no other content controls, though additional code could be used to work around that - which would make the code longer...

There is always some give and take isn't there. Thank you for the additional dialogue. You are all the best!