Insert a condition in Find and Replace

RobiNew · #1 12-02-2023, 11:06 AM

I'm trying to insert a condition in the code here below. The style should be replaced only if the number of italicized characters is less than 30. Can someone help? Thanks!

Code:

Sub Italic()
With ActiveDocument
If Not .Styles("myItalic") Is Nothing Then
  For iType = 1 To 2
    Set aRng = ActiveDocument.StoryRanges(iType)
    With aRng.Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Text = ""
      .Replacement.Text = ""
      .Font.Italic = True
If aRng.Characters.Range.Count < 30 Then _
.Replacement.Style = ActiveDocument.Styles("myItalic")
      .Forward = True
      .Wrap = wdFindContinue
      .Format = True
      .MatchCase = False
      .Execute Replace:=wdReplaceAll
    End With
  Next iType
End If
End With
End Sub

vivka · #2 12-02-2023, 03:18 PM

Hi, RobiNew! The following code finds italicized strings in each storyrange and, if the italicized string is less-than-30-chars-long, the whole storyrange gets styled as needed. I tested the code only once, so it may have some problems.

Code:

Sub Italicize_If()

Dim aRng As range
  For iType = 1 To 2
    Set aRng = ActiveDocument.StoryRanges(iType)
    With aRng.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .text = ""
        .Replacement.text = ""
        .Font.Italic = True
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        Do
        If .Execute And aRng.Characters.count < 30 Then
            aRng.Select
            ActiveDocument.StoryRanges(iType).Style = "myItalic"
            GoTo lbl_next
        End If
        aRng.Collapse wdCollapseEnd
        Loop
    End With
lbl_next:
  Next iType
lbl_exit:
Set aRng = Nothing
End Sub

RobiNew · #3 12-03-2023, 12:27 AM

Hi, Vivka! Thank you for your code, but that isn't what I need. My fault: I didn't explain properly what I need. The macro should convert only the italicized strings of the doc except when the italicized string is longer than 30 characters.

vivka · #4 12-03-2023, 03:08 AM

Hi, RobiNew! Try this:

Code:

Sub Italicize_If()

Dim aRng As range
  For iType = 1 To 2
    Set aRng = ActiveDocument.StoryRanges(iType)
    With aRng.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .text = ""
        .Replacement.text = ""
        .Font.Italic = True
        .Forward = True
        .Wrap = wdFindStop
        .Format = True
        .MatchCase = False
        Do
           If .Execute And aRng.Characters.count < 30 Then
               aRng.Select
               selection.Style = "myItalic"
           End If
           aRng.Collapse wdCollapseEnd
        Loop While .found
    End With
  Next iType
lbl_exit:
Set aRng = Nothing 
Exit Sub
End Sub

RobiNew · #5 12-03-2023, 07:12 AM

Thanks a lot, Vivka! It ins't the fasted code you've suggested but it works perfectly.

vivka · #6 12-03-2023, 07:46 AM

You are welcome, RobiNew! I've just slightly modified your code. And, really, I don't know a better code for doing this job. I think, your algorithm is quite fast and optimal. Maybe experts here, if they want, can offer a different solution. I'd like to have another good lesson!

RobiNew · #7 12-03-2023, 09:48 AM

Well, that was just a friendly comment! Perhaps you can explain why the code here below doesn't work at all. I want to go to the first page of the document without using Selection. Thanks!

Code:

Dim myRange As Range
Set myRange = ActiveDocument.Content
myRange.Collapse Direction:=wdCollapseStart

vivka · #8 12-03-2023, 02:54 PM

RobiNew, as for me,
selection.HomeKey wdStory
is the best way of moving the cursor to the doc's start.
If you don't like it, you can use
ActiveDocument.range(0, 0).Select

RobiNew · #9 12-03-2023, 03:28 PM

Many thanks, Vivka!

Guessed · #10 12-03-2023, 03:35 PM

This variation on Vivka's code avoids the selection object and hence it runs a lot faster.

Code:

Sub Italicize_If2()
  Dim aRng As Range, iType As Integer
  For iType = 1 To 2
    Set aRng = ActiveDocument.StoryRanges(iType)
    With aRng.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = ""
        .Replacement.Text = ""
        .Font.Italic = True
        .Forward = True
        .Wrap = wdFindStop
        .Format = True
        .MatchCase = False
        Do While .Execute
          If aRng.Characters.Count < 30 Then aRng.Style = "myItalic"
          aRng.Collapse wdCollapseEnd
        Loop
    End With
  Next iType
lbl_exit:
  Set aRng = Nothing
  Exit Sub
End Sub

RobiNew · #11 12-04-2023, 01:53 AM

Thanks a lot, Guessed! It is an improvement.

vivka · #12 12-04-2023, 05:43 AM

Thank you, Andrew! I added selection to make the found instance visible. Without it, the code is definitely faster. I live and learn.

gmaxey · #13 12-04-2023, 06:19 AM

Quote:

Originally Posted by RobiNew

Well, that was just a friendly comment! Perhaps you can explain why the code here below doesn't work at all. I want to go to the first page of the document without using Selection. Thanks!

Code:

Dim myRange As Range
Set myRange = ActiveDocument.Content
myRange.Collapse Direction:=wdCollapseStart

RobiNew

Your code does work for what you are telling it to do. After running that code, the range is at the start of the document. Consider:

Code:

Sub ScrahtchMacro()
'A basic Word Macro coded by Gregory K. Maxey
Dim myRange As Range
Set myRange = ActiveDocument.Content
myRange.Collapse Direction:=wdCollapseStart
myRange.InsertBefore "I'm here."
lbl_Exit:
  Exit Sub
End Sub

If you want to start typing at the start of the document then you have to move the insert point to the start of the document as others have explained.

vivka · #14 12-04-2023, 07:23 AM

Yes, Greg, you are absolutely right! I was about to write this to RobiNew with the demonstration you used.

RobiNew · #15 12-04-2023, 07:48 AM

Many thanks to you both! I'm trying to get rid of Selection, but it isn't always easy.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Find & Replace to insert thousands separators	jeffreybrown	Word	3	10-19-2019 04:37 PM
Find and replace condition	norgro	Word VBA	2	07-31-2015 06:38 AM
Find and Replace - How to insert brackets around all numbers in a doc	Natedogg	Word	2	05-21-2015 07:16 AM
Insert text at the end of a sentence Find/Replace	AlmostFriday	Word	6	06-17-2012 05:21 AM
Find & Replace Insert Issue	mipacker	Word	0	02-18-2009 08:59 AM