Search code examples
vbams-wordstr-replace

Replacing Comma character with Serial No


In place of
Comma space Anil, Comma space Sunil etc as illustrated below:

, Anil, Sunil etc

. I want to Give Serial No in Same Line like:

(1) Anil (2) Sunil etc

'The Procedure has to do a lot of unnecessary work. Is there a better way.

'Put Curser anywhere befor first Comma

Sub GiveSerialToLinerPoints()
   

x = ActiveDocument.Range(0, Selection.Paragraphs(1). _
Range.End).Paragraphs.Count
i = 0
For Each char In ActiveDocument.Paragraphs(x).Range.Characters
    
        If char = "," Then
            i = i + 1
        End If
Next char

TotalCommas = i

For i = 1 To TotalCommas
    With Selection
            .StartIsActive = False
            .Extend Character:=","
            .Collapse Direction:=wdCollapseEnd
            .MoveLeft
            .Expand Unit:=wdCharacter

                    If .Text = "," Then
                            .Text = " (" & i & ")"
                    End If
        End With
  Next i
End Sub

Solution

  • Try:

    Sub Demo()
    Application.ScreenUpdating = False
    Dim i As Long
    With ActiveDocument.Range
      With .Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = ","
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
      End With
      Do While .Find.Execute
        i = i + 1
        .Text = "(" & i & ")"
        .Collapse wdCollapseEnd
      Loop
    End With
    Application.ScreenUpdating = True
    MsgBox i & " commas replaced."
    End Sub
    

    To limit the F/R to just the paragraph the insertion point is in, you could use:

    Sub Demo()
    Application.ScreenUpdating = False
    Dim Rng As Range, i As Long
    With Selection.Paragraphs.First
      Set Rng = .Range
      With .Range
        With .Find
          .ClearFormatting
          .Replacement.ClearFormatting
          .Text = ","
          .Replacement.Text = ""
          .Forward = True
          .Wrap = wdFindStop
          .Format = False
          .MatchCase = False
          .MatchWholeWord = False
          .MatchWildcards = False
          .MatchSoundsLike = False
          .MatchAllWordForms = False
        End With
        Do While .Find.Execute
          If .InRange(Rng) Then
            i = i + 1
            .Text = "(" & i & ")"
          Else
            Exit Do
          End If
          .Collapse wdCollapseEnd
        Loop
      End With
    End With
    Application.ScreenUpdating = True
    MsgBox i & " instances found."
    End Sub