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

What is =ROMAN(40) in Excel?
The Roman numeral for 40 is XL. Bill "MrExcel" Jelen's 40th book was called MrExcel XL.
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.
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
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:
Upvote 0
Solution
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.
 
Upvote 0
I just amended the last code to ignore blank cells.
 
Upvote 0

Forum statistics

Threads
1,213,484
Messages
6,113,924
Members
448,533
Latest member
thietbibeboiwasaco

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
Back
Top