Two fonts in row of cell using VBA

[scubadivingfool]

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.

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

 

[RoryA]

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:

Two fonts in row of cell using VBA

I want two fonts in the same cell. The second row, is price and the unit of measure (for example ea, dz, cs, pk). When I work on one cell, the activeCell.character is looking for a start for the fi...

stackoverflow.com

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]

This:

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

should be something like:

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

 

[scubadivingfool]

This:

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

should be something like:

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]

You need a loop as you're only doing the active cell currently:

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

 

[scubadivingfool]

You need a loop as you're only doing the active cell currently:

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]

I just amended the last code to ignore blank cells.