1

I have two blocks of Word VBA code here that each work fine separately, but which I need to combine in order to obtain the desired result. One identifies a range of text (oRng), while the other runs a Selection.Find search to alter some text. I need to limit the Selection.Find search to the range defined by oRng.

Background: I have a variable list of news articles divided into sections under headers (single paragraph in Header1 style), which are also variable. I need to select the source line in the article (single paragraph in bold) and copy it to the end of the article header (single paragraph in Header2 style). However, certain sections need to be excluded from this operation, if the section header is a specific term.

Situation: I have working code to find the article source lines and copy them to the end of the article headers (looping through the whole document using Selection.Find). I also have working code to identify the sections of the text where the first set of code needs to be applied, by creating ranges (oRng) between applicable section headers, looping through the document section by section. What I need to do is run the first set of code (which is based around Selection.Find) within the ranges specified by the second set of code. My intention was to loop the code to identify the ranges and as it identifies each range, run the code to copy the source lines to the headers within that range, but I can't find a way to limit the Selection.Find search to a specific Range (oRng).

Can anyone help me out with this, please?

First block of code (Identify ranges between applicable section headers)

Sub SourceToArticleHeadersP2()
Dim oRng As Range
Dim oRngstart As Range
Dim oRngend As Range
Dim ArticleSource As Range
Dim ArticleHeader As Range
Dim excludedTerms(1 To 5) As String
excludedTerms(1) = "Term1"
excludedTerms(2) = "Term1"
excludedTerms(3) = "Term1"
excludedTerms(4) = "Term1"
excludedTerms(5) = "Term1"

Selection.HomeKey Unit:=wdStory
With Selection.Find
.Forward = True
.ClearFormatting
.Wrap = wdFindStop
.Style = ActiveDocument.Styles(wdStyleHeading1)
.Text = ""
.Execute
End With
Do While Selection.Find.Found
 For i = 1 To 5
  If InStr(1, Selection.Text, excludedTerms(i), vbTextCompare) Then
  Selection.Collapse wdCollapseEnd
  MsgBox excludedTerms(i) & " detected - skipping"
  Selection.Find.Execute
  End If
 Next i
 Set oRngstart = Selection.Range
 MsgBox "Start = " & oRngstart
 Selection.Collapse wdCollapseEnd
 With Selection.Find
  .Forward = True
  .ClearFormatting
  .Wrap = wdFindStop
  .Style = ActiveDocument.Styles(wdStyleHeading1)
  .Text = ""
  .Execute
 End With
 If Selection.Find.Found Then
  Set oRngend = Selection.Range
  MsgBox "End = " & oRngend
  Set oRng = ActiveDocument.Range(Start:=oRngstart.End, End:=oRngend.Start)
  Selection.Collapse wdCollapseStart
  Selection.Find.Execute
 Else
  MsgBox "End = End of Document"
  Set oRng = ActiveDocument.Range(Start:=oRngstart.End, End:=ActiveDocument.Range.End)
 End If
Loop
[SECOND BLOCK OF CODE GOES HERE]
End Sub

Second block of code (identify source lines and copy to article header lines, based on formatting). I need to modify this so that it works only on the range of text oRng.

With Selection.Find
 .Forward = True
 .ClearFormatting
 .Wrap = wdFindStop
 .Style = ActiveDocument.Styles(wdStyleHeading2)
 .Text = ""
 .Execute
End With
Do While Selection.Find.Found
 Set ArticleHeader = ActiveDocument.Range(Selection.Range.Start, Selection.Range.End - 1)
 With Selection.Find
  .Forward = True
  .ClearFormatting
  .Wrap = wdFindStop
  .Font.Bold = True
  .Text = ""
  .Execute
  End With
 Set ArticleSource = ActiveDocument.Range(Selection.Range.Start, Selection.Range.End - 1)
 ArticleHeader.InsertAfter " (" & ArticleSource & ")"
 Selection.Collapse wdCollapseEnd
 With Selection.Find
  .Forward = True
  .ClearFormatting
  .Wrap = wdFindStop
  .Style = ActiveDocument.Styles(wdStyleHeading2)
  .Text = ""
  .Execute
 End With
Loop

The target document has a similar layout to this (number of sections and articles is variable). Lines I'm searching for in the code above are in bold:

[2+ Pages of opening text and TOC]

Section header 1 (Style: Heading1)

Article 1 header (Style: Heading2)
Variable lines of header text
Article 1 source name (in bold)
More variable lines of header text
Article body text
Page break

Article 2 header (Style: Heading2)
Variable lines of header text
Article 2 source name (in bold)
More variable lines of header text
Article body text
Page break

Section header 2 (Style: Heading1)

Article 3 header (Style: Heading2)
Variable lines of header text
Article 3 source name (in bold)
More variable lines of header text
Article body text
Page break

[...]

  • @Raystafarian thanks for the comment - my issue is that I can't find a way to run the Selection.Find command only within the range identified - it currently searches the whole document. I haven't identified as a global because my initial intention was to combine these into a single sub. I've seen that the range can be identified as a selection, and selection.find run within that, but as my code alters the selection in order to carry out its function, I believe this will not work either, as the selection will have changed when the next loop comes round? – Lobosolitario Mar 4 '15 at 11:16
  • @Raystafarian I was mainly using .selection because I worked out that section of code first. There's no problem with changing it if that will achieve the desired result. I've tried using oRng.find as well, but it seems to have similar problems - the search is not being limited to the original oRng range. – Lobosolitario Mar 4 '15 at 12:14
  • What I'm trying to do is: Define oRng. From start of oRng: Find first text with style Heading2. Add to range ArticleHeader, minus last character. From the end of first text with style Heading2, find first text with bold font. Add to range ArticleSource, minus last character. Insert ArticleSource contents after ArticleHeader, between brackets. Repeat this sequence in following text until the end of oRng. Define new oRng, repeat sequence again. The problem I'm finding is that any search I run in a defined range seems to redefine the range? – Lobosolitario Mar 4 '15 at 12:22
  • Maybe I can define the selection as oRng, and then progressively redefine it as (current position, oRng.end) while it loops? – Lobosolitario Mar 4 '15 at 12:42
  • From what I can tell, in P2 you are using selection to set orng. You define other ranges (article*), but those don't show up in P2. P2 ends with oRng set to a range. Yes? Then in P1 you use the ranges defined in P2 but not used, and don't use oRng at all. I also don't see P1 calling P2 or P2 calling P1. – Raystafarian Mar 4 '15 at 12:58
1

I was able to resolve this in the end by counting the paragraphs in oRng which used the Header2 style, and looping the second search the appropriate number of times from the beginning of oRng (code below).

I'd still be very interested to know if there's another way to limit a loop with multiple searches so that it only operates within a specific range - the only idea I have would be to run the first search using oRng.Find, collapse to end, redefine oRng as (current position, oRngend) and cycle through that way, with the range becoming progressively smaller as the search moves forward until it reaches the point where there are no matches between the current position and oRngend.

Thanks a million to @Raystafarian for lots of helpful suggestions and a large dose of patience!

Sub SourceToArticleHeaders()
'Copy article source to article header
    Dim oRng As Range
    Dim oRngstart As Range
    Dim oRngend As Range
    Dim ArticleSource As Range
    Dim ArticleHeader As Range
    Dim oPara As Paragraph
    Dim A As Long
    A = 0
    Dim excludedTerms(1 To 5) As String
    excludedTerms(1) = "TERM1"
    excludedTerms(2) = "TERM1"
    excludedTerms(3) = "TERM1"
    excludedTerms(4) = "TERM1"
    excludedTerms(5) = "TERM1"

    Selection.HomeKey Unit:=wdStory
    With Selection.Find
    .Forward = True
    .ClearFormatting
    .Wrap = wdFindStop
    .Style = ActiveDocument.Styles(wdStyleHeading1)
    .Text = ""
    .Execute
    End With
    Do While Selection.Find.Found
     For i = 1 To 5
      If InStr(1, Selection.Text, excludedTerms(i), vbTextCompare) Then
      Selection.Collapse wdCollapseEnd
'      MsgBox excludedTerms(i) & " detected - skipping"
      Selection.Find.Execute
      End If
     Next i
     Set oRngstart = Selection.Range
'     MsgBox "Start = " & oRngstart
     Selection.Collapse wdCollapseEnd
     With Selection.Find
      .Forward = True
      .ClearFormatting
      .Wrap = wdFindStop
      .Style = ActiveDocument.Styles(wdStyleHeading1)
      .Text = ""
      .Execute
     End With
     If Selection.Find.Found Then
      Set oRngend = Selection.Range
'      MsgBox "End = " & oRngend
      Set oRng = ActiveDocument.Range(Start:=oRngstart.End, End:=oRngend.Start)
      Selection.Collapse wdCollapseStart
      Selection.Find.Execute
     Else
'      MsgBox "End = End of Document"
      Set oRng = ActiveDocument.Range(Start:=oRngstart.End, End:=ActiveDocument.Range.End)
     End If
     For Each oPara In oRng.Paragraphs
      If oPara.Range.Style = ActiveDocument.Styles(wdStyleHeading2) Then
      A = A + 1
      End If
     Next
'     MsgBox A & " articles"
     oRng.Select
     For A = 1 To A
     With Selection.Find
     .Forward = True
     .ClearFormatting
     .Wrap = wdFindStop
     .Style = ActiveDocument.Styles(wdStyleHeading2)
     .Text = ""
     .Execute
     End With
     Set ArticleHeader = ActiveDocument.Range(Selection.Range.Start, Selection.Range.End - 1)
     Selection.Collapse wdCollapseEnd
     With Selection.Find
      .Forward = True
      .ClearFormatting
      .Wrap = wdFindStop
      .Font.Bold = True
      .Text = ""
      .Execute
     End With
     Set ArticleSource = ActiveDocument.Range(Selection.Range.Start, Selection.Range.End - 1)
     ArticleHeader.InsertAfter " (" & ArticleSource & ")"
     Selection.Collapse wdCollapseEnd
     Next A
     A = 0
     With Selection.Find
      .Forward = True
      .ClearFormatting
      .Wrap = wdFindStop
      .Style = ActiveDocument.Styles(wdStyleHeading1)
      .Text = ""
      .Execute
     End With
    Loop
End Sub

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.