VBA help Only format selected text in manual to schedule level numbering

[Shelley_Lou]

2924729247

I would be really grateful for some help with my macro. The macro converts manual numbering to the correct outline schedule level number, converts schedule level 1 to bold and keep with next and any unnumbered paragraphs from body text to body 1 only when text is selected. It all works fine except when it gets to body text to body 1. In my test document I have selected the text to the end of paragraph 2 (so the end of 2.2.2.2) then I run the macro. Paragraph 3 onwards should remain body text but the macro converts the unselected text to body 1. I can't quite work out where I am going wrong. Can anyone help?


Sub ManualToSchedule_Sched1Bold()
Application.ScreenUpdating = False
Dim Para As Paragraph, Rng As Range, iLvl As Long, i As Paragraph, n As Long, StyleName As String, wrd As Long, Count As Long
If Len(Selection.Range) = 0 Then
MsgBox "Select the text first", vbCritical
Exit Sub
End If
With Selection.Range
For Each i In ActiveDocument.Paragraphs 'Remove all leading spaces e.g tabs, spaces, NBS
For n = 1 To i.Range.Characters.Count
If i.Range.Characters(1).Text = " " Or i.Range.Characters(1).Text = " " Or i.Range.Characters(1).Text = Chr(9) Or i.Range.Characters(1).Text = Chr(160) Then
i.Range.Characters(1).Delete
Else: Exit For
End If
Next n
Next
For Each Para In .Paragraphs
If Para.Range.Information(wdWithInTable) = False Then
Set Rng = Para.Range.Words.First 'Convert manual numbering to Schedule Level numbering
With Rng
If IsNumeric(.Text) Then
While .Characters.Last.Next.Text Like "[0-9. " & vbTab & "]"
.End = .End + 1
Wend
iLvl = UBound(Split(.Text, "."))
If IsNumeric(Split(.Text, ".")(UBound(Split(.Text, ".")))) Then iLvl = iLvl + 1
If iLvl < 10 Then
.Text = vbNullString
Para.Style = "Schedule Level " & iLvl
End If
End If
End With
End If
Next
End With
With Selection.Range.Find
.ClearFormatting
.Replacement.ClearFormatting
.Style = "Schedule Level 1" 'format Schedule Level 1 bold with KWN
.Font.Bold = False
.Text = ""
.Replacement.Font.Bold = True
.Replacement.Text = ""
.Replacement.ParagraphFormat.KeepWithNext = True
.Forward = True
.Wrap = wdFindStop
.Execute Replace:=wdReplaceAll

End With
With Selection.Range.Find
.ClearFormatting
.Replacement.ClearFormatting
.Style = "Body Text"
.Text = ""
.Replacement.Style = "Body1"
.Replacement.Font.Bold = False
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Execute Replace:=wdReplaceAll
End With
Application.ScreenUpdating = True
End Sub

[Chas Kenyon]

I would strongly advise using Styles to control your numbering, as described in Shauna Kelly's page How to create numbered headings or outline numbering in Ribbon Versions of Word by Shauna Kelly (http://www.shaunakelly.com/word/numbering/numbering20072010.html). Then use your macros to apply the appropriate styles.

[Shelley_Lou]

Hi Chas many thanks for your reply, please note my document does contain the correct Styles to be used in our documents Heading 1-7, Schedule Level 1-7 and Body 1-7 all contained within the Styles pane and Body Text is used in place of the Normal style, the macro works well except it is changing unselected text for Body 1 even though I am using wdFindStop so this is where I'm not too sure where I am going wrong.

[Shelley_Lou]

I have had to mark this thread as solved even though it isn't, I've just removed the body text part of the code so I can run it and will have to manually adjust the non-numbered paragraphs as I still can't figure out why its changing text that hasn't been selected.

[jec1]

Hi Shelley
First select first line of text with Body Text and then use Select dropdown text with similar formatting and change to Body1.
Then select all your text and run your macro - it seems to work okay.

It worked for me.

Janine