VBA code that changes the font size of spaces but only applied to selected text

I want to be able to automatically change the font size of the spaces between words of a selected line, but not the font size of the words themselves. So instead of this:
https://i.imgur.com/5GIKPS6.png
... I wanted to get this:
https://i.imgur.com/WW3g3IA.png
... and then change the font size of this spacing, always with ‘0.5pt’ less, so for example from ‘9pt’ to ‘8.5pt’.

Someone suggested to record a macro while doing the following:

Quote:

---

- Highlight the sentence(s)
- Open FIND & REPLACE (e.g. CTRL + H)
- Add one space to the FIND field
- Add one space to the REPLACE field
- With the cursor still in the REPLACE field, go to "More" >> "Format" >> "Font", select the required font size of the space and click "OK"
- Click "Replace All"

Look into recording macros. You could record 3 macros. Each one would do the steps mentioned above (spart ftom highlighting the text) to select the 3 required font size for the space and to run the replace all command. Then, these macros could be assigned toolbar buttons or keyboard shortcuts. After setting these up, you would just need to highlight the text and run the macro for the required space font size.

---

The problem however, is that it doesn't only change the font of the selected line, but also of all the other lines, or of that line and all the previous/next lines. I’m getting the following code:

Code:

---

Sub Macro1()
'
' Macro1 Macro
'
'
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Font.Size = 8.5
    With Selection.Find
        .Text = " "
        .Replacement.Text = " "
        .Forward = False
        .Wrap = wdFindAsk
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

---

Is there someone who could tweak this so it will end up only affecting the selected line? Thank you so much in advance, you’ll be a lifesaver.

Note: apparently I'm not the first one with a similar problem. There is an entire website by Greg Maxey that handles the '.Find' option. But I'm still asking the question on this forum because English isn't my first language and I don't know sh*t about coding. So I'm hoping that someone here can help me further with just a couple of tweaks instead of me spending hours of trying to figure it out and probably get nowhere. And I know this because I've already asked it on Reddit and someone seems to have posted something that could help me further and although I'm very greatful, it reads like Chinese to me. And that - unfortunately - isn’t my first language either.

Welcome to VBAX ResidentCV. I'm not a Word guru but maybe try this

Code:

---

Sub ReduceSpaces()
    Application.ScreenUpdating =False
    With ActiveDocument.Content.Find
        .ClearFormatting
        .Text ="^w"
        .Replacement.ClearFormatting
        .Replacement.Text ="  "
        .MatchCase =False
        .MatchWholeWord =False
        .MatchWildcards =False
        .Execute Replace:=wdReplaceAll
    EndWith
    Application.ScreenUpdating =True
End Sub


---

Note in the line .Replacement.Text = " ", we have two spaces between the quotation marks.

HTH
Aussiebear

Quote:

---

Originally Posted by Aussiebear

Welcome to VBAX ResidentCV. I'm not a Word guru but maybe try this

Code:

---

Sub ReduceSpaces()
    Application.ScreenUpdating =False
    With ActiveDocument.Content.Find
        .ClearFormatting
        .Text ="^w"
        .Replacement.ClearFormatting
        .Replacement.Text ="  "
        .MatchCase =False
        .MatchWholeWord =False
        .MatchWildcards =False
        .Execute Replace:=wdReplaceAll
    EndWith
    Application.ScreenUpdating =True
End Sub


---

Note in the line .Replacement.Text = " ", we have two spaces between the quotation marks.

HTH
Aussiebear

---

Hey Aussiebear,

Thanks for trying to help! Unfortunately I'm getting the error "sub of function isn't defined" and the macro doesn't seem to do anything. Any suggestions?

https://i.imgur.com/SSvLc04.png

Did you select the text first? Split the End With as well.

Quote:

---

Originally Posted by Aussiebear

Did you select the text first? Split the End With as well.

---

I did select the text and have now also tried it with and without selecting text, but... nothing happens. I've seperated 'End' and 'With' with a space and same result. I think I'll just have to accept that it isn't possible. Do you get a result when trying it out in Word?

Maybe something interesting to know future-wise: which of these coding lines makes (or at least should make) the font go smaller with 0.5pt?

Code:

---

Sub ReduceSpaces()
Dim oRng As Range
  Application.ScreenUpdating = False
  Set oRng = Selection.Range
  With oRng.Find
    .ClearFormatting
    .Text = "^w"
    .Replacement.ClearFormatting
    .Replacement.Font.Size = oRng.Font.Size - 0.5
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .Execute Replace:=wdReplaceAll
  End With
  Application.ScreenUpdating = True
lbl_Exit:
  Exit Sub
End Sub

---

Quote:

---

Originally Posted by gmaxey

Code:

---

Sub ReduceSpaces()
Dim oRng As Range
  Application.ScreenUpdating = False
  Set oRng = Selection.Range
  With oRng.Find
    .ClearFormatting
    .Text = "^w"
    .Replacement.ClearFormatting
    .Replacement.Font.Size = oRng.Font.Size - 0.5
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .Execute Replace:=wdReplaceAll
  End With
  Application.ScreenUpdating = True
lbl_Exit:
  Exit Sub
End Sub

---

---

You know, I was already considering trying to find a method to contact you after seeing your site, but I thought you'd already have retired from helping people or something.

Goddamn thank you so much! This is a big step forward in the right direction. The only thing I did from here on, to be able to go from 9pt to 8pt and so forth, is creating separate macros where the 'original font size' is reduced with '1pt', '1.5pt' and '2pt'.

It does seem to work that way, but the only thing I can't figure out is how to assign a keyboard shortcut (e.g. ctrl+7) to a macro. Because the way I do it now, is to create a faux macro, assign a key to it, and then paste your code into it. But once I do that, the shortcut combination doesn't work anymore. Any suggestions?

Also: is there a way the code can detect the font size of the spacing and reduce that by 0.5? Then I only need one macro :yes

Why don't you use one macro and set the reduction size variable in it:

Code:

---

Sub ReduceSpaces()
Dim oRng As Range
  Application.ScreenUpdating = False
  Set oRng = Selection.Range
  With oRng.Find
    .ClearFormatting
    .Text = "^w"
    .Replacement.ClearFormatting
    .Replacement.Font.Size = oRng.Font.Size - InputBox("Enter the reduction value in whole or half points e.g., 1.5", "SET REDUCTION", "0.5")
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .Execute Replace:=wdReplaceAll
  End With
  Application.ScreenUpdating = True
lbl_Exit:
  Exit Sub
End Sub

---

Quote:

---

Originally Posted by gmaxey

Why don't you use one macro and set the reduction size variable in it:

---

I apparently can do that indeed. I just didn't know this was even an option (I have a very limited understanding about coding so I have to figure out everything that people answer). Thank you! Now I only have to figure out how to assign a shortcut key to a changed macro :)

Edit: found it. Thank you internet, thanks everyone in this topic and a special thanks to you also, Greg Maxey. You all have no idea how much easier this makes my life. I'm going to mark this topic as solved.