Solved: Change style for paragraphs starting with "Chapter"

[Paul_Hossler]

Looking for a piece of code that will look through all paragraphs in a document, and if the paragraph starts with a certain word, change the style to (for ex.) Heading 1

Would like to use it to help re-format/cleanup imported text files

Right now I do the multiple spaces to one space, multiple paragraphs to one, etc., and I'd like to include the code in my Reformat macro.

I can (thanks to the macro recorder) muddle my way though the formatting, etc. but it's the looping and testing.

Here's a before and after sample.

Thanks

Paul

[macropod]

Hi Paul,

Try something along the lines of:
Sub Demo()
Dim oPara As Paragraph
With ActiveDocument
For Each oPara In .Paragraphs
With oPara.Range
If .Words(1) = "Chapter" Then .Style = "Heading 1"
End With
Next
End With
End Sub

[Paul_Hossler]

Elegant, and easy to follow -- thanks :clap:

In case you're interested (and even if you're not :) ), here's the "final" result.

So far it seems to be working OK, and making life much easier



Option Explicit
Sub Demo()

Dim oSelection As Object

Application.ScreenUpdating = False

Set oSelection = Selection


Call StyleBasedOnFirstParaWord("chapter", "Heading 1")
Call StyleBasedOnFirstParaWord("topic", "Heading 2")
Call StyleBasedOnFirstParaWord("Part", "Heading 3")
Call StyleBasedOnFirstParaWord("section", "Heading 4")

oSelection.Select

Application.ScreenUpdating = True

End Sub

Sub StyleBasedOnFirstParaWord(sFirstWord As String, sStyle As String)
Dim oPara As Paragraph

With ActiveDocument
For Each oPara In .Paragraphs
With oPara.Range
If LCase(Trim(sFirstWord)) = LCase(Trim(.Words(1))) Then
.Select
Selection.Range.Case = wdLowerCase
Selection.Range.Case = wdTitleWord
.Style = sStyle
End If
End With
Next
End With

End Sub



Thanks again :beerchug:

Paul

[fumei]

Why are you using oSelection in Demo? It does not do anything.

[Paul_Hossler]

oSelection was just a piece of left over code that I did not cleanup when I got done trying some different things, and before I modularized the guts of the logic within StyleBasedOnFirstParaWord()

Demo() was just a driver, what I really wanted to do was include calls to StyleBasedOnFirstParaWord() as part of a longer macro

Paul

[macropod]

Hi Paul,

You could make the code much more efficient this way:
Sub Demo()
Application.ScreenUpdating = False
Dim oPara As Paragraph
With ActiveDocument
For Each oPara In .Paragraphs
With oPara.Range
Select Case Trim(LCase(.Words(1)))
Case "chapter"
.Style = "Heading 1"
.Case = wdTitleWord
Case "topic"
.Style = "Heading 2"
.Case = wdTitleWord
Case "part"
.Style = "Heading 3"
.Case = wdTitleWord
Case "section"
.Style = "Heading 4"
.Case = wdTitleWord
End Select
End With
Next
End With
Application.ScreenUpdating = True
End SubUsing selections is very inefficient and, if you test the lower-case version of the 1st word against a lower-case constant (which is mostly what you had), there is no need to do a case conversion of the constant. You also had two case conversions per paragraph, where one would do. Finally, the way your code was implemented, it had to loop through all paragraphs once for each test - the above does it all in one pass.

[Paul_Hossler]

Thanks, those are good points

If the specific .Words(1) turn out to be relatively unchanigng, that's what I'll do to avoid all that looping.

However, I tried to apply wdTitleWord only, but it wasn't always reliable, so I forced it to wdLowerCase first, and then wdTitleWord. Look at the results without it.

Just using this bit of code, the "Chapter 1 - AAAAAAAAAAAAA AAAAAAAAA" first line doesn't become "Chapter 1 - Aaaaaaaaaaaaa Aaaaaaaaa" without making it LC first. Confusing to me, unless I am missing something.


Sub Demo()
Dim oPara As Paragraph

Application.ScreenUpdating = False

For Each oPara In ActiveDocument.Paragraphs
With oPara.Range
Select Case Trim(LCase(.Words(1)))
Case "chapter"
.Style = "Heading 1"
' .Case = wdLowerCase 'Uncomment this line, and Chapter 1 works as expected
.Case = wdTitleWord
End Select
End With
Next

Application.ScreenUpdating = True

End Sub


Paul

[macropod]

Hi Paul,

Don't you just love it when you've got to do two case conversions where one should do!

You seem to be suggesting you'll use the more efficient approach only if "the specific .Words(1) turn out to be relatively unchanigng". Even if that's not the scenario you'll be working with, the Select Case approach is much more efficient - especially on longer documents. FWIW, the Select Case approach allows you to simultaeneously test multiple conditions for which the same treatment applies. For example, consider the following, in which I've added 'volume' to the 'chapter' case:
Sub Demo()
Application.ScreenUpdating = False
Dim oPara As Paragraph
With ActiveDocument
For Each oPara In .Paragraphs
With oPara.Range
Select Case Trim(LCase(.Words(1)))
Case "chapter", "volume"
.Style = "Heading 1"
.Case = wdLowerCase
.Case = wdTitleWord
Case "topic"
.Style = "Heading 2"
.Case = wdLowerCase
.Case = wdTitleWord
Case "part"
.Style = "Heading 3"
.Case = wdLowerCase
.Case = wdTitleWord
Case "section"
.Style = "Heading 4"
.Case = wdLowerCase
.Case = wdTitleWord
End Select
End With
Next
End With
Application.ScreenUpdating = True
End SubAnother approach, which you may find more flexible, is to solicit the key word for each heading level. For example:
Sub Demo()
Application.ScreenUpdating = False
Dim oPara As Paragraph
Dim Case1 As String
Dim Case2 As String
Dim Case3 As String
Dim Case4 As String
With ActiveDocument
Case1 = LCase(InputBox("Key Word for Heading 1", "Text Reformatting"))
Case2 = LCase(InputBox("Key Word for Heading 2", "Text Reformatting"))
Case3 = LCase(InputBox("Key Word for Heading 3", "Text Reformatting"))
Case4 = LCase(InputBox("Key Word for Heading 4", "Text Reformatting"))
For Each oPara In .Paragraphs
With oPara.Range
Select Case Trim(LCase(.Words(1)))
Case Case1
.Style = "Heading 1"
.Case = wdLowerCase
.Case = wdTitleWord
Case Case2
.Style = "Heading 2"
.Case = wdLowerCase
.Case = wdTitleWord
Case Case3
.Style = "Heading 3"
.Case = wdLowerCase
.Case = wdTitleWord
Case Case4
.Style = "Heading 4"
.Case = wdLowerCase
.Case = wdTitleWord
End Select
End With
Next
End With
Application.ScreenUpdating = True
End Sub

:wavey:

[Paul_Hossler]

Don't you just love it when you've got to do two case conversions where one should do!
:wavey:

Lots of :banghead: trying to figure out what I was doing wrong

You have 2 good points -- I'll go to the Case (your #1) and if I find I have to update it too much for different documents, I think I'll add a InputBox (your #2) to that sub to handle a "special' case

Thanks for your time and efforts on this

Paul

[Paul_Hossler]

Thanks again

Paul

[fumei]

Hi Paul. What I think macropod is suggesting (correctly) is that using Select Case is more efficient than If...Else statements.

Further, there seems to be a confusion as to "word". macropod is using Trim because "Chapter 1" is two words.

.Words(1) is "Chapter " - including the trailing space. Just for brevity, skipping Trim:
Dim oPara As Paragraph
For Each oPara In ActiveDocument.Paragraphs
With oPara.Range
Select Case LCase(.Words(1))
Case "chapter " ' with trailing space
.Case = wdTitleWord
.Style = "Heading 1"
End Select
End With
Next

works for me.

"Chapter 1 - AAAAAAAAAAAAA AAAAAAAAA"

becomes

"Chapter 1 - Aaaaaaaaaaaaa Aaaaaaaaa"

with no need to make it LowerCase first.

However, the real point is that if you are doing multiple test on the SAME variable - in this case .Words(1) - using Select Case is always faster than multiple If statements.

It is the reason there is a Select Case.