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!