Help, How to have only a selected text to change = Range

Cendrinne · #1 01-26-2025, 02:39 PM

Hi Pros,

I've had notes to select text to Find and Replace only what I've selected, but both Notes I had, doesn't work. So I'm not certain what I'm doing wrong.

So I have text prior, that didn't get touch, it's going forward.

For example, Dates, I wish to modify from a format to another format + Language.

Is there a way to select a Specific Range to modify? Nothing before and nothing afterwards?

If so, please guide me, cause all my text is being changed.

Code:

Dim oRng As Range
   Application.ScreenUpdating = False
   
    Set oRng = ActiveDocument.Range(Start:=Selection.Range.Start, End:=Selection.Range.End)
    
    Selection.Select
    Selection.languageID = wdFrenchCanadian
    Selection.NoProofing = False
    Application.CheckLanguage = True
    
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Font.Color = 16711937                             'Blue HTML 1/1/255

    With Selection.Find
        .Forward = True
        .Wrap = wdFindStop
        .Format = True
        .MatchCase = True
        .MatchWildcards = True
        
        .text = "([A-Z][a-z]{2})( {1})([0-9]{1;2})(,)( )([0-9]{2})"
        .Replacement.text = "\3 \1\2 20\6"
    Selection.Find.Execute Replace:=wdReplaceAll
    End With
    
   
' Ajt_Select_Col_Mod_Langue_a_Fr Macro
'
    Set oRng = ActiveDocument.Range(Selection.Range.Start, Selection.Range.End)

    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Font.Color = 16711937                                   'Blue HTML 1/1/255
    With Selection.Find
        .Forward = True
        .Wrap = wdFindStop
        .Format = True
        .MatchCase = True
        .MatchWildcards = False
        
        .text = "Jan"
        .Replacement.text = "janv."
    Selection.Find.Execute Replace:=wdReplaceAll
    
        .text = "Feb"
        .Replacement.text = "févr."
    Selection.Find.Execute Replace:=wdReplaceAll
    
        .text = "Mar"
        .Replacement.text = "mars"
    Selection.Find.Execute Replace:=wdReplaceAll
        
        .text = "Apr"
        .Replacement.text = "avr."
    Selection.Find.Execute Replace:=wdReplaceAll
        
        .text = "May"
        .Replacement.text = "mai"
    Selection.Find.Execute Replace:=wdReplaceAll
    
        .text = "Jun"
        .Replacement.text = "juin"
    Selection.Find.Execute Replace:=wdReplaceAll
    
        .text = "Jul"
        .Replacement.text = "juill."
    Selection.Find.Execute Replace:=wdReplaceAll
    
        .text = "Aug"
        .Replacement.text = "août"
    Selection.Find.Execute Replace:=wdReplaceAll
    
        .text = "Sep"
        .Replacement.text = "sept."
    Selection.Find.Execute Replace:=wdReplaceAll
    
        .text = "Oct"
        .Replacement.text = "oct."
    Selection.Find.Execute Replace:=wdReplaceAll
    
        .text = "Nov"
        .Replacement.text = "nov."
    Selection.Find.Execute Replace:=wdReplaceAll
    
        .text = "Dec"
        .Replacement.text = "déc."
    Selection.Find.Execute Replace:=wdReplaceAll
    End With

Any insights would be very appreciated.

batman1 · #2 01-26-2025, 05:15 PM

As far as I understand what this is about

Code:

Sub demo()
Dim oRng As Range, months, k As Long
    If Selection.End = Selection.Start Then Exit Sub
    
    Application.ScreenUpdating = False
   
    Set oRng = Selection.Range
    
    With oRng
        Selection.LanguageID = wdFrenchCanadian
        Selection.NoProofing = False
    End With
    Application.CheckLanguage = True
    
    months = Array(Array("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"), _
    Array("janv.", "févr.", "mars", "avr.", "mai", "juin", "juill.", "aout", "sept.", "oct.", "nov.", "déc."))

    With oRng.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Replacement.Font.Color = 16711937                             'Blue HTML 1/1/255
        .MatchCase = True
        .MatchWildcards = True
        .Text = "([A-Z][a-z]{2}) ([0-9]{1;2}), ([0-9]{2})"
        .Replacement.Text = "\2 \1 20\3"
        .Execute Replace:=wdReplaceAll
        oRng.Expand wdWord
        .ClearFormatting
        .Replacement.ClearFormatting
        .Replacement.Font.Color = 16711937
        .MatchCase = True
        .MatchWildcards = False
        For k = 0 To 11
            .Text = months(0)(k)
            .Replacement.Text = months(1)(k)
            .Execute Replace:=wdReplaceAll
        Next k
    End With
    Application.ScreenUpdating = True
End Sub

Cendrinne · #3 01-26-2025, 06:26 PM

OMG, all afternoon, it kept trying and trying.

The only thing I thought of doing, was to put a font color and if it is that exact font color then do the Find and Replace.

However, I left your script in black or automatic and it WORKS!!!!!!

Thank you so much. This helps me so much.

I can't thank you enough

macropod · #4 01-26-2025, 08:14 PM

Another way:

Code:

Sub Demo()
Application.ScreenUpdating = False
Dim Rng As Range
Application.CheckLanguage = True
With Selection
  Set Rng = .Range
  .LanguageID = wdFrenchCanadian
  .NoProofing = False
  With .Range
    With .Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Text = "<[JFMASOND][abceglnoprtuvy]{2} [0-9]{1;2}, [0-9]{2}>"
      .Replacement.Text = ""
      .MatchWildcards = True
      .Wrap = wdFindStop
      .Forward = True
      .Format = False
    End With
    Do While .Find.Execute
      If .InRange(Rng) Then
        Select Case Split(.Text, " ")(0)
          Case "Jan": .Text = Split(Split(.Text, " ")(1), ",")(0) & " janv. 20" & Split(.Text, " ")(2)
          Case "Feb": .Text = Split(Split(.Text, " ")(1), ",")(0) & " févr. 20" & Split(.Text, " ")(2)
          Case "Mar": .Text = Split(Split(.Text, " ")(1), ",")(0) & " mars 20" & Split(.Text, " ")(2)
          Case "Apr": .Text = Split(Split(.Text, " ")(1), ",")(0) & " avr. 20" & Split(.Text, " ")(2)
          Case "May": .Text = Split(Split(.Text, " ")(1), ",")(0) & " mai 20" & Split(.Text, " ")(2)
          Case "Jun": .Text = Split(Split(.Text, " ")(1), ",")(0) & " juin 20" & Split(.Text, " ")(2)
          Case "Jul": .Text = Split(Split(.Text, " ")(1), ",")(0) & " juill. 20" & Split(.Text, " ")(2)
          Case "Aug": .Text = Split(Split(.Text, " ")(1), ",")(0) & " août 20" & Split(.Text, " ")(2)
          Case "Sep": .Text = Split(Split(.Text, " ")(1), ",")(0) & " sept. 20" & Split(.Text, " ")(2)
          Case "Oct": .Text = Split(Split(.Text, " ")(1), ",")(0) & " oct. 20" & Split(.Text, " ")(2)
          Case "Nov": .Text = Split(Split(.Text, " ")(1), ",")(0) & " nov. 20" & Split(.Text, " ")(2)
          Case "Dec": .Text = Split(Split(.Text, " ")(1), ",")(0) & " déc. 20" & Split(.Text, " ")(2)
        End Select
        .Font.Color = 16711937 'Blue HTML 1/1/255
      Else
        Exit Do
      End If
      .Collapse wdCollapseEnd
    Loop
  End With
End With
Application.ScreenUpdating = True
End Sub

Cendrinne · #5 01-26-2025, 09:29 PM

Thanks so much, Paul

Cheers to you too and Happy New Year

Cendrinne · #6 01-26-2025, 10:31 PM

For those who would copy this script from macropod.....

I don't fully understand it yet, but hey it works

Spent all day, trying to figure things, out, maybe during the week, I'll get it

Thank you again, Paul, that is why you are an expert

Cendrinne · #7 01-26-2025, 10:51 PM

Hi Paul, ouffffffff what a script. Magical but I don't get it.

I'm wondering cause at times, I will see: for example...
Jan 1, 20 or Jan. 1, 20
Feb 1, 20 or Feb. 1, 20

and other times, I will see

Long dates in both languages.

So I can fix, what I do understand, but I cannot fix what I don't understand.

So if I want to put in English = 3 Letters and a period, where do I put it? LOL

What are all the Split?

Sorry, this is very advance, but I don't mind learning :

Thanks again for your help.

macropod · #8 01-26-2025, 11:03 PM

In which case you could use:

Code:

Sub Demo()
Application.ScreenUpdating = False
Dim Rng As Range, StrYY As String, StrMM As String, StrDD As String
Application.CheckLanguage = True
With Selection
  Set Rng = .Range
  .LanguageID = wdFrenchCanadian
  .NoProofing = False
  With .Range
    With .Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Text = "<[JFMASOND][a-z.]{2;9} [0-9]{1;2}, [0-9]{2;4}>"
      .Replacement.Text = ""
      .MatchWildcards = True
      .Wrap = wdFindStop
      .Forward = True
      .Format = False
    End With
    Do While .Find.Execute
      If .InRange(Rng) Then
        StrYY = Split(.Text, " ")(2): StrMM = Left(Split(.Text, " ")(0), 3): StrDD = Split(Split(.Text, " ")(1), ",")(0)
        If Len(StrYY) = 2 Then StrYY = "20" & StrYY
         Select Case StrMM
          Case "Jan": StrMM = " janv. "
          Case "Feb": StrMM = " févr. "
          Case "Mar": StrMM = " mars "
          Case "Apr": StrMM = " avr. "
          Case "May": StrMM = " mai "
          Case "Jun": StrMM = " juin "
          Case "Jul": StrMM = " juill. "
          Case "Aug": StrMM = " août "
          Case "Sep": StrMM = " sept. "
          Case "Oct": StrMM = " oct. "
          Case "Nov": StrMM = " nov. "
          Case "Dec": StrMM = " déc. "
        End Select
        .Text = StrDD & StrMM & StrYY
        .Font.Color = 16711937 'Blue HTML 1/1/255
      Else
        Exit Do
      End If
      .Collapse wdCollapseEnd
    Loop
  End With
End With
Application.ScreenUpdating = True
End Sub

With the Find expression:
• <[JFMASOND][a-z.]{2;9} looks for the month, with or without the abbreviation period and regardless of whether it's in a short date or long date format;
• [0-9]{1;2}, looks for the day; and
• [0-9]{2;4}> looks for the year in 2-digit to 4-digit format.
The Split function can be used to separate out different elements as a string. By splitting the string at each space, the various parts of the date can be differentiated as if they're a 0-based array. So, given the Find pattern:
• Split(.Text, " ")(0) gets the month;
• Split(.Text, " ")(1) gets the day. Nesting it, thus Split(Split(.Text, " ")(1), ",")(0), eliminates the comma, if present; and
• Split(.Text, " ")(2) gets the year

gmaxey · #9 01-27-2025, 07:02 AM

Paul is undisputed absolute master of using and keeping track of complex split or replace strings and yes they work very well!

The following is by no means superior, but you might find it easier to understand:

Code:

Sub Modified_MacroPod_Demo()
'A few more variables
Dim varParts
Dim varMonths
Dim LS As String
Dim lngMonthIndex As Long
Dim oRng As Range, oRngCheck As Range
  Application.ScreenUpdating = False
  Application.CheckLanguage = True
  'Get the regional list separator for use in the find string.
  LS = CreateObject("WScript.Shell").RegRead("HKEY_CURRENT_USER\Control Panel\International\sList")
  'Define the various month replacments in a string, then convert to an array.
  varMonths = Split("janv.|févr.|mars|avr.|mai|juin|juill.|août|sept.|oct.|nov.|déc.", "|")
  Set oRng = Selection.Range
  
  With oRng
    Set oRngCheck = .Duplicate
    .LanguageID = wdFrenchCanadian
    .NoProofing = False
  End With
  With oRng.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    'Modified using the regional list separator character.
    .Text = "<[JFMASOND][a-z.]{2" & LS & "9} [0-9]{1" & LS & "2}, [0-9]{2" & LS & "4}>"
    .Replacement.Text = ""
    .MatchWildcards = True
    .Wrap = wdFindStop
    .Forward = True
    .Format = False
    Do While .Execute
      With oRng
        If .InRange(oRngCheck) Then
          'Create an array of the date parts i.e., day, month, year.
          varParts = Split(oRng.Text, " ")
          'Find the index of the month part.
          lngMonthIndex = Month("1 " & (Left(varParts(0), 3)) & " 2025")
          'If the year part is only 2 digits, prefix with "20"
          If Len(varParts(2)) = 2 Then varParts(2) = "20" & varParts(2)
          'Build the replacement string.
          'a) The "day" part will include the comma.  Strip it out: Replace(varParts(1), ",", "")
          'b) The "month" part will be pulled from varMonths defined above: varMonths(lngMonthIndex - 1)
          .Text = Replace(varParts(1), ",", "") & " " & varMonths(lngMonthIndex - 1) & " " & varParts(2)
          .Font.Color = 16711937
          .Collapse wdCollapseEnd
        Else
          Exit Do
        End If
      End With
    Loop
  End With
  Application.ScreenUpdating = True
lbl_Exit:
  Exit Sub
End Sub

macropod · #10 01-27-2025, 02:59 PM

I've done a bit of refinement myself. See the modified code in my previous post.

Greg: With your approach, it would be more efficient to use:

Code:

LS = Application.International(wdListSeparator)

Cendrinne · #11 01-28-2025, 07:46 AM

Paul, I will test this out after work. Thank you.

Greg, thank you thank you, and happy new year, my friend

Batman1, thank you again for having helped me out. I'm sure you won't keep the title novice. But read and analyze both scripts by the two gentlemen.

Experts!!!!!!

One day, I aim to get there

I'll try things out and let you know, either this week or weekend when I have more time.

Again, you are all awesome

gmaxey · #12 01-28-2025, 01:10 PM

Quote:

Originally Posted by macropod

Greg: With your approach, it would be more efficient to use:

Code:

LS = Application.International(wdListSeparator)

Paul,

Would you believe I used to know that

. Thanks for jogging my memory.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Count lines within selected text range	eduzs	Word VBA	4	09-17-2023 05:22 PM
Change background of selected text	ultrarunner2020	Word	5	03-10-2023 02:59 PM
Applying a VBA code only on a selected text or range	RobertDany	Word VBA	2	10-09-2021 08:31 AM
How to change color indicating selected text	daylee	Word	1	03-27-2019 01:31 PM
Please help. I want to change the text of a cell when another is selected	frankzelnik	Excel	5	06-19-2018 01:34 PM