Two fonts in row of cell using VBA

scubadivingfool

New Member
Joined
Jun 17, 2010
Messages
35
OK, having trouble having two fonts in the same cell. I need to have the 2nd row, which is price and the unit of measure (ie. ea, dz, cs, pk). I was thinking of looking and seeing how the code works when I just work on one cell, but soon found that the activeCell.character is looking for a start and need for the first font and a start for the second font. Do to the fact that the price does change is size from 3 numbers including those after the decimal place to 4, 5 and 6 this method won't wok.


1644582082046.png


VBA Code:
Sub TwoFonts2()

Dim MyPos, SearchChar
SearchChar = "."


Rows("2:2").Select
With ActiveCell.Characters(Start:=1, Length:=8).Font
    .Name = "ITC Avant Garde Std Bk"
    .FontStyle = "Bold"
    .Size = 26
    .Strikethrough = False
    .Superscript = False
    .Subscript = False
    .OutlineFont = False
    .Shadow = False
    .Underline = xlUnderlineStyleNone
    .ThemeColor = xlThemeColorLight1
    .TintAndShade = 0
    .ThemeFont = xlThemeFontNone
End With
With MyPos = (InStr(SearchChar, x, " ") + 3)
    .Name = "ITC Avant Garde Std Bk"
    .FontStyle = "Bold"
    .Size = 14
    .Strikethrough = False
    .Superscript = False
    .Subscript = False
    .OutlineFont = False
    .Shadow = False
    .Underline = xlUnderlineStyleNone
    .ThemeColor = xlThemeColorLight1
    .TintAndShade = 0
    .ThemeFont = xlThemeFontNone
End With

End Sub
 

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.

RoryA

MrExcel MVP, Moderator
Joined
May 2, 2008
Messages
39,378
Office Version
  1. 365
  2. 2019
  3. 2016
  4. 2010
Platform
  1. Windows
  2. MacOS
A reminder:

Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at:
If you have posted the question at more places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.
 

RoryA

MrExcel MVP, Moderator
Joined
May 2, 2008
Messages
39,378
Office Version
  1. 365
  2. 2019
  3. 2016
  4. 2010
Platform
  1. Windows
  2. MacOS
This:

Code:
With MyPos = (InStr(SearchChar, x, " ") + 3)

should be something like:

Code:
MyPos = InStr(1, activecell.value, SearchChar) + 3
With ActiveCell.Characters(Start:=mypos).Font
 

scubadivingfool

New Member
Joined
Jun 17, 2010
Messages
35
This:

Code:
With MyPos = (InStr(SearchChar, x, " ") + 3)

should be something like:

Code:
MyPos = InStr(1, activecell.value, SearchChar) + 3
With ActiveCell.Characters(Start:=mypos).Font
Sort of works. Does what I need it to do but only in A2. I need it to do it all in Row 2. I know I am missing something but new to VBA
 

RoryA

MrExcel MVP, Moderator
Joined
May 2, 2008
Messages
39,378
Office Version
  1. 365
  2. 2019
  3. 2016
  4. 2010
Platform
  1. Windows
  2. MacOS
You need a loop as you're only doing the active cell currently:

Code:
Sub TwoFonts2()

Dim MyPos, SearchChar
SearchChar = "."


for each cell in rows("2:2").cells
if len(cell.value) <> 0 then
With cell.Characters(Start:=1, Length:=8).Font
    .Name = "ITC Avant Garde Std Bk"
    .FontStyle = "Bold"
    .Size = 26
    .Strikethrough = False
    .Superscript = False
    .Subscript = False
    .OutlineFont = False
    .Shadow = False
    .Underline = xlUnderlineStyleNone
    .ThemeColor = xlThemeColorLight1
    .TintAndShade = 0
    .ThemeFont = xlThemeFontNone
End With
MyPos = InStr(1, cell.value, SearchChar) + 3
With cell.Characters(Start:=mypos).Font
    .Name = "ITC Avant Garde Std Bk"
    .FontStyle = "Bold"
    .Size = 14
    .Strikethrough = False
    .Superscript = False
    .Subscript = False
    .OutlineFont = False
    .Shadow = False
    .Underline = xlUnderlineStyleNone
    .ThemeColor = xlThemeColorLight1
    .TintAndShade = 0
    .ThemeFont = xlThemeFontNone
End With
end if
next cell
End Sub
 
Last edited:
Solution

scubadivingfool

New Member
Joined
Jun 17, 2010
Messages
35
You need a loop as you're only doing the active cell currently:

Code:
Sub TwoFonts2()

Dim MyPos, SearchChar
SearchChar = "."


for each cell in rows("2:2").cells
With cell.Characters(Start:=1, Length:=8).Font
    .Name = "ITC Avant Garde Std Bk"
    .FontStyle = "Bold"
    .Size = 26
    .Strikethrough = False
    .Superscript = False
    .Subscript = False
    .OutlineFont = False
    .Shadow = False
    .Underline = xlUnderlineStyleNone
    .ThemeColor = xlThemeColorLight1
    .TintAndShade = 0
    .ThemeFont = xlThemeFontNone
End With
MyPos = InStr(1, cell.value, SearchChar) + 3
With cell.Characters(Start:=mypos).Font
    .Name = "ITC Avant Garde Std Bk"
    .FontStyle = "Bold"
    .Size = 14
    .Strikethrough = False
    .Superscript = False
    .Subscript = False
    .OutlineFont = False
    .Shadow = False
    .Underline = xlUnderlineStyleNone
    .ThemeColor = xlThemeColorLight1
    .TintAndShade = 0
    .ThemeFont = xlThemeFontNone
End With
next cell
End Sub
OK, perfect. ok, not quite as I wasn't clear that I just needed the cells with the price in them and not every cell including the blank ones.
 

RoryA

MrExcel MVP, Moderator
Joined
May 2, 2008
Messages
39,378
Office Version
  1. 365
  2. 2019
  3. 2016
  4. 2010
Platform
  1. Windows
  2. MacOS
I just amended the last code to ignore blank cells.
 

Forum statistics

Threads
1,176,671
Messages
5,904,384
Members
435,089
Latest member
blackstapler

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top