VBA help With Selection.Range not working

Shelley Lou · #1 12-16-2021, 01:38 AM

Hi, I have put together the below macro from various vba I have found on line and modified it to do what I need it to do. I want to be able to select the text (very important), remove any leading spaces/tabs, convert manual numbering to Schedule Level numbering, change Schedule Level 1 to bold and any non-numbered paragraphs from Body Text to Body 1 which is pretty much does. Only problem is it is also changing the formatting of the main Schedule Heading and Part Heading even though I am only selecting the text underneath it. Not sure where I am going wrong with the Selection.Range command in the code. Can anyone help please. Thank you

Test Schedule Numbering Doc.docx

Code:

Sub DPU_AutoNumbering_Schedule_ExcTables()
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
ActiveDocument.Range.Style = "Body Text"
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.Find
.ClearFormatting
.Replacement.ClearFormatting
         .Wrap = wdFindContinue
         .Forward = True
         .Format = True
    .MatchWildcards = False
    .Style = "Schedule Level 1" 'format Schedule Level 1 bold
    .Font.Bold = False
        .Text = ""
        .Replacement.Font.Bold = True
        .Replacement.Text = ""
        .Execute Replace:=wdReplaceAll
   End With
   With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
         .Wrap = wdFindContinue
         .Forward = True
         .Format = True
    .MatchWildcards = False
    .Style = "Body Text"
        .Text = ""
        .Replacement.Style = "Body1"
        .Replacement.Font.Bold = False
        .Replacement.Text = ""
        .Execute Replace:=wdReplaceAll
        
     End With
   Application.ScreenUpdating = True
   
End Sub

Shelley Lou · #2 12-23-2021, 06:24 AM

I think I have now solved my issue with the Selection.Range formatting outside of the selected text by removing the ActiveDocument at the beginning of the code and it now seems to work.

Code:

Sub DPU_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
        .Font.Bold = False
        .Text = ""
        .Replacement.Font.Bold = True
        .Replacement.Text = ""
        .Replacement.ParagraphFormat.KeepWithNext = True
        .Forward = True
        .Wrap = wdFindStop
        .Execute Replace:=wdReplaceAll
End With

   Application.ScreenUpdating = True
End Sub

Thread Tools
Show Printable Version Email this Page
Display Modes
Linear Mode Switch to Hybrid Mode Switch to Threaded Mode

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Selection object and its Range property	jpl	Word VBA	4	04-13-2020 06:05 AM
How to get start and end range indices of a selection	paik1002	Word VBA	7	07-02-2017 10:44 PM
Distribute text in one cell across a range of cells (overcoming selection.range.cells.count bug)	slaycock	Word VBA	0	02-18-2017 07:00 AM
Working with Selection.range.	PRA007	Word VBA	2	02-19-2016 12:52 AM
Selection or Range	Tommes93	Word VBA	1	04-10-2014 02:50 AM