CODEWITHSUNDEEP
vbaexcelfunctionfonts
rellik
rellik

Reputation: 304

Change Part of text font in Excel cell using vba

Hi I am trying to create a function to calculate milliohms (mOhms) my function is

Function mOhms(Current, Voltage)
mOhms = Format((Voltage / Current) * 1000, "00.00 m") & Chr(87)
End Function

with results being

40.00 mW (if cell values are 24 and 1 respectivly)

How do i get the W as (Ω) ohms symbol if i change the cell font style to Symbol m changes to micro (μ) symbol

i have tried paying with

With ActiveCell.Characters(Start:=Len(ActiveCell) - 1, Length:=1).Font
.FontStyle = "Symbol"
End With

Which results in "Circular reference error"s

Need some help to resolve this

Upvotes: 2

Views: 3237

Answers (2)

user3598756
user3598756

Reputation: 29421

should you want to stick with Characters object you have to:

  • use Name property, instead of FontStyle one

  • set its Start parameter to the last character of the range text, instead of the second to last one

so you may want to code like follows:

Sub main()
    With Range("G1") '<--| change this to any valid Range reference
        .Value = mOhms(24, 1) '<--| set the referenced range value
        FormatOhm .Cells '<--| format the referenced range value last character
    End With
End Sub

Function mOhms(Current, Voltage)
    mOhms = Format((Voltage / Current) * 1000, "00.00 m") & Chr(87)
End Function

Sub FormatOhm(rng As Range)
    With rng
        .Characters(Start:=Len(.Value), Length:=1).Font.name = "Symbol"
    End With
End Sub

a possible enhancement of which could be the handling of "W" character actual position in the string, should it not always be the last character

then you could add the following function:

Function GetCharacter(rng As Range, char As String) As Long
    Dim i As Long

    With rng
        For i = 1 To .Characters.Count
            If .Characters(i, 1).Text = char Then
                GetCharacter = i
                Exit For
            End If
        Next i
    End With
End Function

that returns a Long with the passed character position inside the passed range value or 0 if no match occurred

in this case you'd have to slightly change FormatOhm() function to have it handle the actual character position:

Sub FormatOhm(rng As Range, iChar As Long)
    If iChar = 0 Then Exit Sub '<--| exit if no character matching occurred
    With rng
        .Characters(Start:=iChar, Length:=1).Font.name = "Symbol"
    End With
End Sub

and your "main" code would then get to:

Sub main()
    With Range("G1") '<--| change this to any valid Range reference
        .Value = mOhms(24, 1) '<--| set the referenced range value
        FormatOhm .Cells, GetCharacter(.Cells, "W") '<--| format the referenced range value character corresponding to "W", if any
    End With
End Sub

of course what above could be further both improved and made more robust, for instance handling char parameter length in GetCharacter() and correspondingly in FormatOhm()

Upvotes: 1

Captain Grumpy
Captain Grumpy

Reputation: 520

Try using Unicode in place of the Chr(87) 

Function mOhms(Current, Voltage)
mOhms = Format((Voltage / Current) * 1000, "00.00 m") & ChrW(&H2126)
End Function

Upvotes: 2

Related Questions