Save Selection

macropod · #16 01-14-2011, 09:26 PM

Hi Brock,

Give the following a spin:

Code:

Sub Demo()
Application.ScreenUpdating = False
Dim strTmp As String, Sctn As Section, oCel As Cell, rngTmp As Range, i As Integer
With ActiveDocument
  For Each Sctn In .Sections
    With Sctn.Range
      If .ContentControls.Count > 0 Then
        strTmp = .ContentControls(1).Range.Text
        For i = 2 To .ContentControls.Count
          strTmp = strTmp & ":" & .ContentControls(i).Range.Text
        Next i
        With ActiveDocument
          For Each oCel In .Tables(1).Range.Cells
            Set rngTmp = oCel.Range
            rngTmp.End = rngTmp.End - 1
            If rngTmp.Text = vbNullString Then
              .Indexes.MarkEntry Range:=rngTmp, Entry:=strTmp, _
                CrossReference:="", CrossReferenceAutoText:="", _
                BookmarkName:="", Bold:=False, Italic:=False
              Exit For
            End If
          Next oCel
        End With
      End If
    End With
  Next Sctn
End With
Set rngTmp = Nothing
Application.ScreenUpdating = True
End Sub

cksm4 · #17 01-15-2011, 10:14 AM

Hello Paul,

The code words!

Is it possible to get the index to paste in its perspective section? For example, I have empty rows throughout the document. So unless I get rid of all but one empty row, section 2's index pastes in sections 1's 1st blank row the code finds.

Also, there are multiple content controls in each section... I only want it to find the first three. The code is finding all 20 and creating an index on all 20. Is it possible to stop the code after the first 3?

Also, section 1-3 are cover pages to the document I am merging and I do not want to run the code on these sections.

That was why I was using the find meathod. But you are right... this is the right way and much more stable and faster.

I really appreciate your help on this... I know this is taking a lot of time!

macropod · #18 01-15-2011, 01:17 PM

Hi Brock,

Try:

Code:

Sub Demo()
Application.ScreenUpdating = False
Dim strTmp As String, oCel As Cell, rngTmp As Range, i As Integer, j As Integer
With ActiveDocument
  If .Sections.Count > 3 Then
    For i = 4 To .Sections.Count
      With .Sections(i).Range
        If .ContentControls.Count > 0 Then
          strTmp = .ContentControls(1).Range.Text
          For j = 2 To .ContentControls.Count
            strTmp = strTmp & ":" & .ContentControls(i).Range.Text
            If j > 2 Then Exit For
          Next j
          For Each oCel In .Tables(1).Range.Cells
            Set rngTmp = oCel.Range
            rngTmp.End = rngTmp.End - 1
            If rngTmp.Text = vbNullString Then
              .Indexes.MarkEntry Range:=rngTmp, Entry:=strTmp, _
                CrossReference:="", CrossReferenceAutoText:="", _
                BookmarkName:="", Bold:=False, Italic:=False
              Exit For
            End If
          Next oCel
        End If
      End With
    Next j
  End If
End With
Set rngTmp = Nothing
Application.ScreenUpdating = True
End Sub

cksm4 · #19 01-15-2011, 01:33 PM

I get the following errors:

Code:

 
.Indexes.MarkEntry Range:=rngTmp, Entry:=strTmp, _

Method or data member not found

Code:

 
Next j

(2nd Next j)

Invalid Next control varible reference

I changed the Next j to Next i and .Indexes.MarkEntry to ActiveDocument.Indexes.MarkEntry. But no indexes are inserted.

macropod · #20 01-15-2011, 07:10 PM

Hi Brock,

Sorry - I hadn't tested the code properly before posting. Try:

Code:

Sub Demo()
Application.ScreenUpdating = False
Dim strTmp As String, oCel As Cell, rngTmp As Range, i As Integer, j As Integer
With ActiveDocument
  If .Sections.Count > 3 Then
    For i = 4 To .Sections.Count
      With .Sections(i).Range
        If .ContentControls.Count > 0 Then
          strTmp = .ContentControls(1).Range.Text
          For j = 2 To .ContentControls.Count
            strTmp = strTmp & ":" & .ContentControls(j).Range.Text
            If j > 2 Then Exit For
          Next j
          For Each oCel In .Tables(1).Range.Cells
            Set rngTmp = oCel.Range
            rngTmp.End = rngTmp.End - 1
            If rngTmp.Text = vbNullString Then
              ActiveDocument.Indexes.MarkEntry Range:=rngTmp, Entry:=strTmp, _
                CrossReference:="", CrossReferenceAutoText:="", _
                BookmarkName:="", Bold:=False, Italic:=False
              Exit For
            End If
          Next oCel
        End If
      End With
    Next i
  End If
End With
Set rngTmp = Nothing
Application.ScreenUpdating = True
End Sub

cksm4 · #21 01-16-2011, 01:08 PM

Hello Paul,

This worked perfect!

Thanks for guiding me towards a better solution and helping me with the proper code. It really helped me tremendously both in this project as well as learning more about VBA!

Brock

cksm4 · #22 01-21-2011, 09:21 AM

Hello Paul,

After much testing, I found that in order to have the users still user their prior forms created in Word 2002, I mush use the find method in my code as Word 2002 does not support rich text controls. I will have the user run a macro that will update the 2002 documents to include the necessary fields; however, they will not be controls. I created the below macro that first determines if there are controls, if yes then it’s a new form and I use the code you provided. If no, then it’s a prior version of the form and the code uses the find method. The problem I am having is that this is not working by section. The text found from the first section using the find method shows up on each section using the same method. When I read the code it appears to me that it is only running by sections… but somehow is it not stopping after each section. Any ideas

? A big thanks for any insight you can provide!

Code:

 
Sub Demo()
 
Application.ScreenUpdating = False
Dim strTmp As String, oCel As Cell, rngTmp As Range, i As Integer, j As Integer
With ActiveDocument
  If .Sections.Count > 5 Then
    For i = 6 To .Sections.Count
      With .Sections(i).Range
        If .ContentControls.Count > 3 Then
          strTmp = .ContentControls(2).Range.Text
          For j = 3 To .ContentControls.Count
            strTmp = strTmp & ":" & .ContentControls(j).Range.Text
            If j > 3 Then Exit For
          Next j
          If Not .ContentControls(5).PlaceholderText = .ContentControls(5).Range.Text Then
          strTmp = strTmp & .ContentControls(5).Range.Text
          End If
          For Each oCel In .Tables(1).Range.Cells
            Set rngTmp = oCel.Range
            rngTmp.End = rngTmp.End - 1
            If rngTmp.Text = vbNullString Then
              ActiveDocument.Indexes.MarkEntry Range:=rngTmp, Entry:=strTmp & employment & """" & " \f " & """" & "TOC", _
                CrossReference:="", CrossReferenceAutoText:="", _
                BookmarkName:="", Bold:=False, Italic:=False
              Exit For
             End If
          Next oCel
        ElseIf .ContentControls.Count = 0 Then
            Selection.Find.ClearFormatting
            With Selection.Find
                .Text = "Category 1:"
                .Replacement.Text = ""
                .Forward = True
                .Wrap = wdFindContinue
            End With
            Selection.Find.Execute
            Selection.MoveRight Unit:=wdCell
            Selection.MoveRight Unit:=wdCell
            strTmp = Selection.Text
            Selection.Collapse
            Selection.Find.ClearFormatting
            With Selection.Find
                .Text = "Category 2:"
                .Replacement.Text = ""
                .Forward = True
                .Wrap = wdFindContinue
            End With
            Selection.Find.Execute
            Selection.MoveRight Unit:=wdCell
            strTmp = strTmp & ":" & Selection.Text
            Selection.Collapse
            Selection.Find.ClearFormatting
            With Selection.Find
                .Text = "Category 3:"
                .Replacement.Text = ""
                .Forward = True
                .Wrap = wdFindContinue
            End With
            Selection.Find.Execute
            Selection.MoveRight Unit:=wdCell
            strTmp = strTmp & ":" & Selection.Text
            Selection.Collapse
            Selection.Find.ClearFormatting
            With Selection.Find
                .Text = "Category 4:"
                .Replacement.Text = ""
                .Forward = True
                .Wrap = wdFindContinue
            End With
            Selection.Find.Execute
            Selection.MoveRight Unit:=wdCell
            strTmp = strTmp & ":" & Selection.Text
            Selection.Collapse
            For Each oCel In .Tables(1).Range.Cells
            Set rngTmp = oCel.Range
            rngTmp.End = rngTmp.End - 1

macropod · #23 01-21-2011, 02:09 PM

Hi Brock,

If you have users with Word 2003 or earlier, they can't use content controls - they'll need to use formfields. Do you mean to say that you want to have formfields and conent controls in the same document? Which version of Word will you be running the code from - always 2007 & later I hope. If so, it's a simple matter to check whether the 'test' section has content controls or formfields and process accordingly (I gave you code for processing formfields in a previous post).

cksm4 · #24 01-30-2011, 09:26 PM

Hello Paul,

I figured it out... I was thinking the # after the content control was the name... I went back over your replies and figured out that the number was based on its order in the selected range. This helped me firgure out what I needed. Thanks!

macropod · #25 01-30-2011, 10:42 PM

Hi Brock,

I trust that your code ended up looking something like:

Code:

Sub Demo()
Application.ScreenUpdating = False
Dim strTmp As String, oCel As Cell, rngTmp As Range, i As Integer, j As Integer
With ActiveDocument
  If .Sections.Count > 3 Then
    For i = 4 To .Sections.Count
      With .Sections(i).Range
        strTmp = ""
        If .ContentControls.Count > 0 Then
          strTmp = .ContentControls(1).Range.Text
          For j = 2 To .ContentControls.Count
            strTmp = strTmp & ":" & .ContentControls(j).Range.Text
            If j > 2 Then Exit For
          Next j
        ElseIf .FormFields.Count > 0 Then
          strTmp = .FormFields(1).Result
          For j = 2 To .FormFields.Count
            strTmp = strTmp & ":" & .FormFields(j).Result
            If j > 2 Then Exit For
          Next j
        End If
        If strTmp <> "" Then
          For Each oCel In .Tables(1).Range.Cells
            Set rngTmp = oCel.Range
            rngTmp.End = rngTmp.End - 1
            If rngTmp.Text = vbNullString Then
              ActiveDocument.Indexes.MarkEntry Range:=rngTmp, Entry:=strTmp, _
                CrossReference:="", CrossReferenceAutoText:="", _
                BookmarkName:="", Bold:=False, Italic:=False
              Exit For
            End If
          Next oCel
        End If
      End With
    Next i
  End If
End With
Set rngTmp = Nothing
Application.ScreenUpdating = True
End Sub

cksm4 · #26 01-30-2011, 11:44 PM

Yes exactly!

Just shows... I am slowly learning

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Textbox updating from combobox selection	paxile2k	Word VBA	0	10-26-2010 02:30 PM
Document selection procedure	kennethc	Word	0	09-15-2010 02:56 PM
The modification is not allowed because selection is locked	aligahk06	Word	0	09-06-2010 06:28 AM
Automatic find replace after selection in dropdown	vsempoux	Word	0	10-28-2009 08:45 AM
Highlighted Selection on Action Settings	mos7sad	PowerPoint	0	10-12-2009 07:48 AM