Need to apply Heading1 to select rows

bobk544 · #1 06-08-2018, 07:06 PM

Hello, i need to apply the Heading1 style to every every row that has the text string of
"C:\_XREF_ALL\App.2018" and the result i'm hoping for is that i will be able to collapse and expand the rows under each Heading1. And basically, this document contains a lot of program code and the beginning of each program starts with the C drive directory reference ie C:\_XREF_ALL\App.2018\Program1 for example. So i'm hoping that when i apply the Heading1 to the full row, i will be able to expand and collapse each program section of code, thanks for any help on this!

Code:

Sub HeaderApply()
Application.ScreenUpdating = False
Dim StrFnd As String, StrSty As String, StrRep As String, i As Long
StrFnd = "C:\_XREF_ALL\App.2018"
StrSty = " Strong,Heading 1,Character Style 1,Italic,Character Style 2"
StrRep = "Placeholder1^& Placeholder2,^&,^&,Placeholder3^& Placeholder4,^&"
With ActiveDocument.Range.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Forward = True
  .Format = True
  .Wrap = wdFindContinue
  .MatchWildcards = True
  .Text = ActiveDocument.Range  'trying to get the whole row text here
  .Replacement.Style = StrSty
  .Execute Replace:=wdReplaceAll
  'For i = 0 To UBound(Split(StrFnd, ","))
  '  .Text = "#" & Split(StrFnd, ",")(i) & "[A-Za-z]@>"
  '  .Replacement.Style = Split(StrSty, ",")(i)
  '  .Replacement.Text = Split(StrRep, ",")(i)
  '  .Execute Replace:=wdReplaceAll
  'Next
End With
Application.ScreenUpdating = True
End Sub

macropod · #2 06-08-2018, 07:35 PM

For what you've described, all you need is:

Code:

Sub HeaderApply()
Application.ScreenUpdating = False
With ActiveDocument.Range.Find
  .ClearFormatting
  .Forward = True
  .Format = False
  .Wrap = wdFindContinue
  .MatchWildcards = False
  .Text = "C:\_XREF_ALL\App.2018"
  With .Replacement
    .ClearFormatting
    .Text = "^&"
    .Style = wdStyleHeading1
  End With
  .Execute Replace:=wdReplaceAll
End With
Application.ScreenUpdating = True
End Sub

but you don't even need a macro for this - just an ordinary Find/Replace with 'Heading 1' specified as the replacement Style.

bobk544 · #3 06-08-2018, 07:56 PM

Great thanks Paul i will try this first thing tomorrow and wow i see you're still around helping people out at all hours, amazing! You should unquestionably get some kind of special MS commendation of service award or something! And as a matter of fact, this app is still using a lot of the code you helped me on in the past and basically i'm using it to cross referencing hundreds of C++, C#, Java and Javascript programs and it helps a lot when analyzing complex code, so with this particular enhancement i'l be able to move blocks of code around easier in the order of the flow ect, thanks again Paul talk tomorrow!

bobk544 · #4 06-09-2018, 05:24 AM

Yeeha works great! many thanks again Paul! and now i can drag and drop whole sections of code over or under to create logical parent child hierarchies of code ect, super!

Ok so i'm going to tool around with this for a while and see if i can figure out a way to collapse and expand all sections with one command, so will get back to you soon, have a nice weekend Paul and great to see you're still out here wow!

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Select rows w/cells containing given character strings, then sum cell in two other col.	LarryHills	Excel	1	02-17-2017 03:55 PM
VBA Word Table - Select More than 1 Column at a time - Apply Formatting	jc491	Word VBA	12	09-24-2015 06:03 AM
TOC showing both Heading1 and Page Number	FormatAdmin	Word	3	03-04-2014 01:20 PM
reference previous heading1	fehenry	Word	5	04-20-2012 01:54 AM
Heading1 does not convert to Kop1	boesh	Word	8	07-02-2010 05:13 AM