Need a litle help please

[Steved]

Hello from Steved

The below macro is designed to firstly find : then delete everything on it's
left including : secondly move to the line below and delete 6 spaces.

Question please how do I program the below macro to stop when at the last
one the it does. ( it does 300) Thankyou.

Sub LeftMargin()
Dim i As Long
For i = 1 To ActiveDocument.Paragraphs.Count
If i > 1 Then
Set MyRange = ActiveDocument.Paragraphs(i).Range
MyRange.End = MyRange.Start + i
Selection.Find.ClearFormatting
With Selection.Find
.Text = "^$:"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.Extend
Selection.HomeKey Unit:=wdLine
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=6
End If
Next i
End Sub

 

[Steved]

Hello from Steved

I found the answer I required by using another answer in this forum.

Thankyou.

Sub LeftMargin()
Selection.HomeKey wdStory
With Selection.Find
.Text = "^$:"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False

Do While .Execute

Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.Extend
Selection.HomeKey Unit:=wdLine
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=6
Loop
End With
End Sub