Bolding a specific part of cell

Question

I have a cell that is referenced as ="Dealer: " & CustomerName. CustomerName is a dictionary referenced name. How could I go along of bolding only "Dealer:" and not the Customer name.

Example:

Dealer: Josh

I have tried

Cells(5, 1).Characters(1, 7).Font.Bold = True

But it only seems to work on non referenced cells only. How could I get this to work on a referenced cell?

Answer 1

Instead of referencing you could simply obtain the cells and place it in a variable, and basically append it. From here you can use the .font.bold functionality to bold a specific part. Lets say on page 2, you have "Dealer: " in cell a1, and "Josh" in b1. Here is an example how it could be done:

Worksheets("Sheet1").Cells(5, "a") = Worksheets("Sheet2").Cells(1, "a") & Worksheets("Sheet1").Cells(1, "b")
Worksheets("Sheet1").Cells(5, "a").Characters(1, 7).Font.Bold = True 'Bolds "dealer:" only.

Answer 2

Requirements:

My understanding is that the OP needs to have in cell A5 the result of the formula ="Dealer: " & CustomerName showing the Dealer: part in bold characters. Now, what it is not clear, is the nature of the CustomerName part of the formula. This solution assumes it corresponds to a Defined Name with workbook scope (let me know if different).

I assume that the reason for using a formula and not writing directly the result of the formula and formatting the A5 cell with a VBA procedure is to allow users to see the data from different customers just by a calculation change in the workbook, rather than by running a VBA procedure.

Let say that we have the following data in a worksheet named Report, were the Defined Name CustomerName has a workbook scope and is hidden. Located at A5 is the formula ="Dealer: " & CustomerName The Fig.1 shows the report with the data for Customer 1.

Fig.1

Now if we change the Customer Number in cell E3 to 4, the report will show the data of the customer selected; without running any VBA procedure. Unfortunately as the cell A5 contains a formula its contents font cannot be partially formatted to show “Dealer: ” in bold characters. The Fig.2 shows the report with the data for Customer 4.

Fig.2

The solution proposed herewith is to Dynamically display the contents of a cell or range in a graphic object

To implement this solution we need to recreate the desired Output Range and add a Shape in A5 that will contain a link to the Output Range. Assuming that we don’t want this Output Range to be seen in the same worksheet were the report is, and keeping mind that the Output Range cells cannot be hidden; let’s create this Output Range in another worksheet named “Customers Data” at B2:C3 (see Fig.3). Enter in B2 Dealer: and in C2 enter the formula =Customer Name then format each cell as required (B2 font bold, C3 can have a different font type if you like – let’s apply font italic for this sample). Ensure the range have the appropriated width so the text does not overflows the cells.

Fig.3

It’s suggested to create a Defined Name for this range. The code below creates the Defined Name called RptDealer.

Const kRptDealer As String = "RptDealer" ‘Have this constant at the top of the Module. It is use by two procedures

Sub Name_ReportDealerName_Add()
'Change Sheetname "Customers Data" and Range "B2:C2" as required
    With ThisWorkbook.Sheets("Customers Data")
        .Cells(2, 2).Value = "Dealer: "
        .Cells(2, 2).Font.Bold = True
        .Cells(2, 3).Formula = "=CustomerName"  'Change as required
        .Cells(2, 3).Font.Italic = True
        With .Parent
            .Names.Add Name:=kRptDealer, RefersTo:=.Sheets("Customers Data").Range("B2:C2") ', _
                Visible:=False 'Visible is True by Default, use False want to have the Name hidden to users
            .Names(kRptDealer).Comment = "Name use for Dealer\Customer picture in report"
        End With
        .Range(kRptDealer).Columns.AutoFit
    End With
    End Sub

Following the above preparations , now we can create the Shape that will be linked to the Output Range named RptDealer. Select at cell A5 in worksheet Report and follow the instructions for Dynamically display cell range contents in a picture or if you prefer use the code below to add and format the linked Shape.

Sub Shape_DealerPicture_Set(rCll As Range)
Const kShpName As String = "_ShpDealer"
Dim rSrc As Range
Dim shpTrg As Shape

    Rem Delete Dealer Shape if present and set Dealer Source Range
    On Error Resume Next
    rCll.Worksheet.Shapes(kShpName).Delete
    On Error GoTo 0

    Rem Set Dealer Source Range
    Set rSrc = ThisWorkbook.Names(kRptDealer).RefersToRange

    Rem Target Cell Settings & Add Picture Shape
    With rCll
        .ClearContents
        If .RowHeight < rSrc.RowHeight Then .RowHeight = rSrc.RowHeight
        If .ColumnWidth < rSrc.Cells(1).ColumnWidth + rSrc.Cells(2).ColumnWidth Then _
            .ColumnWidth = rSrc.Cells(1).ColumnWidth + rSrc.Cells(2).ColumnWidth
        rSrc.CopyPicture
        .PasteSpecial
        Selection.Formula = rSrc.Address(External:=1)
        Selection.PrintObject = msoTrue
        Application.CutCopyMode = False
        Application.Goto .Cells(1)
        Set shpTrg = .Worksheet.Shapes(.Worksheet.Shapes.Count)
    End With

    Rem Shape Settings
    With shpTrg
        On Error Resume Next
        .Name = "_ShpDealer"
        On Error GoTo 0
        .Locked = msoFalse
        .Fill.Visible = msoFalse
        .Line.Visible = msoFalse
        .ScaleHeight 1, msoTrue
        .ScaleWidth 1, msoTrue
        .LockAspectRatio = msoTrue
        .Placement = xlMoveAndSize
        .Locked = msoTrue
    End With

    End Sub

The code above can be called using this procedure:

Sub DealerPicture_Apply()
Dim rCll As Range
    Set rCll = ThisWorkbook.Sheets("Report").Cells(5, 1)
    Call Shape_DealerPicture_Set(rCll)
    End Sub

The end result is a Picture that behaves like a formula as it is linked to the Output Range containing the formula and format desired (see Fig.4)

Fig.4

Answer 3

As they already told you can't format a partial cell value if this latter derives from a formula/function in that same cell

However there may be some workarounds that may suit your needs

Unluckily I can't actually grasp your real environment so here are some blind shots:

---

1st "environment"

You have a VBA code running that at some point writes in a cell like:

Cells(5, 1).Formula = "=""Dealer: "" & CustomerName"

and you want to have the "Dealer:" part bold

• the most straightforward way would then be

  With Cells(5, 1)
      .Formula = "=""Dealer: "" & CustomerName"
      .Value = .Value
      .Characters(1, 7).Font.Bold = True
  End With
  

• but you could also use the Worksheet_Change() event handler as follows:

  your VBA code is only

  Cells(5, 1).Formula = "=""Dealer: "" & CustomerName"
  

  while placing the following code in the relevant worksheet code pane:

  Private Sub Worksheet_Change(ByVal Target As Range)
      With Target
          If Left(.Text, 7) = "Dealer:" Then
              Application.EnableEvents = False '<-- prevent this macro to be fired again and again by the statement following in two rows
              On Error GoTo ExitSub
              .Value = .Value
              .Characters(1, 7).Font.Bold = True
          End If
      End With
  
  ExitSub:
      Application.EnableEvents = True '<-- get standard event handling back
  End Sub
  

  where On Error GoTo ExitSub and ExitSub: Application.EnableEvents = True shouldn't be necessary, but I left them as a good practice when Application.EnableEvents = False id used

---

2nd "environment"

You have cell(s) in your excel worksheet containing a formula, like:

="Dealer:" & CustomerName

where CustomerName is a named range

and your VBA code is going to modify the content of that named range

in this case the Worksheet_Change() sub would be triggered by the named range value change and not by the cell containing the formula

so I'd go checking if the changed cell is a valid one (i.e. corresponding to a well known named range) and then go with a sub that scans a predefined range and finds and format all cells with formulas that use that `named range, like follows (comments should help you):

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    With Target
        If Not Intersect(ActiveWorkbook.Names("CustomerName").RefersToRange, Target) Is Nothing Then
            Application.EnableEvents = False '<-- prevent this macro to be fired again and again by the statement following in two rows
            On Error GoTo ExitSub
            FormatCells Columns(1), "CustomerName" '<-- call a specific sub that will properly format all cells of passed range that contains reference to passed "named range" name
        End If
    End With

ExitSub:
    Application.EnableEvents = True '<-- get standard event handling back
End Sub

Sub FormatCells(rng As Range, strngInFormula As String)
    Dim f As Range
    Dim firstAddress As String

    With rng.SpecialCells(xlCellTypeFormulas) '<--| reference passed range cells containg formulas only
        Set f = .Find(what:=strngInFormula, LookIn:=xlFormulas, lookat:=xlPart) '<--| search for the first cell in the referenced range containing the passed formula part
        If Not f Is Nothing Then '<--| if found
            firstAddress = f.Address '<--| store first found cell address
            Do '<--| start looping through all possible matching criteria cells
                f.Value = f.Value '<--| change current cell content into text resulting from its formula
                f.Characters(1, 7).Font.Bold = True '<--| make its first 7 characters bold
                Set f = .FindNext(f) '<--| search for next matching cell
            Loop While f.Address <> firstAddress '<--| exit loop before 'Find()' method wraps back to the first cell found
        End If
    End With
End Sub

Answer 4

You can use the below function to bold some input text within a formula

So in your cell you can now type =Bold("Dealer: ")&CustomerName

To be precise – this will only embolden alphabetical characters (a to z and A to Z) all others will be left unchanged. I haven’t tested it on different platforms, but seems to work on mine. May not be supported for all fonts.

 Function Bold(sIn As String)
    Dim sOut As String, Char As String
    Dim Code As Long, i As Long
    Dim Bytes(0 To 3) As Byte

    Bytes(0) = 53
    Bytes(1) = 216

    For i = 1 To Len(sIn)
        Char = Mid(sIn, i, 1)
        Code = Asc(Char)
        If (Code > 64 And Code < 91) Or (Code > 96 And Code < 123) Then
            Code = Code + IIf(Code > 96, 56717, 56723)
            Bytes(2) = Code Mod 256
            Bytes(3) = Code \ 256
            Char = Bytes
        End If
        sOut = sOut & Char
    Next i
    Bold = sOut
End Function

Edit:

Have made an effort to refactor the above to show how it works, rather than have it peppered with magical numbers.

  Function Bold(ByRef sIn As String) As String
     ' Maps an input string to the Mathematical Bold Sans Serif characters of Unicode
     ' Only works for Alphanumeric charactes, will return all other characters unchanged

     Const ASCII_UPPER_A As Byte = &H41
     Const ASCII_UPPER_Z As Byte = &H5A
     Const ASCII_LOWER_A As Byte = &H61
     Const ASCII_LOWER_Z As Byte = &H7A
     Const ASCII_DIGIT_0 As Byte = &H30
     Const ASCII_DIGIT_9 As Byte = &H39
     Const UNICODE_SANS_BOLD_UPPER_A As Long = &H1D5D4
     Const UNICODE_SANS_BOLD_LOWER_A As Long = &H1D5EE
     Const UNICODE_SANS_BOLD_DIGIT_0 As Long = &H1D7EC

     Dim sOut As String
     Dim Char As String
     Dim Code As Long
     Dim i As Long

     For i = 1 To Len(sIn)
        Char = Mid(sIn, i, 1)
        Code = AscW(Char)
        Select Case Code
           Case ASCII_UPPER_A To ASCII_UPPER_Z
              ' Upper Case Letter
              sOut = sOut & ChrWW(UNICODE_SANS_BOLD_UPPER_A + Code - ASCII_UPPER_A)
           Case ASCII_LOWER_A To ASCII_LOWER_Z
              ' Lower Case Letter
              sOut = sOut & ChrWW(UNICODE_SANS_BOLD_LOWER_A + Code - ASCII_LOWER_A)
           Case ASCII_DIGIT_0 To ASCII_DIGIT_9
              ' Digit
              sOut = sOut & ChrWW(UNICODE_SANS_BOLD_DIGIT_0 + Code - ASCII_DIGIT_0)
           Case Else:
              ' Not available as bold, return input character
              sOut = sOut & Char
        End Select
     Next i
     Bold = sOut
  End Function

  Function ChrWW(ByRef Unicode As Long) As String
     ' Converts from a Unicode to a character,
     ' Includes the Supplementary Tables which are not normally reachable using the VBA ChrW function

     Const LOWEST_UNICODE As Long = &H0              '<--- Lowest value available in unicode
     Const HIGHEST_UNICODE As Long = &H10FFFF        '<--- Highest vale available in unicode
     Const SUPPLEMENTARY_UNICODE As Long = &H10000   '<--- Beginning of Supplementary Tables in Unicode. Also used in conversion to UTF16 Code Units
     Const TEN_BITS As Long = &H400                  '<--- Ten Binary Digits - equivalent to 2^10. Used in converstion to UTF16 Code Units
     Const HIGH_SURROGATE_CONST As Long = &HD800     '<--- Constant used in conversion from unicode to UTF16 Code Units
     Const LOW_SURROGATE_CONST As Long = &HDC00      '<--- Constant used in conversion from unicode to UTF16 Code Units

     Dim highSurrogate As Long, lowSurrogate As Long

     Select Case Unicode
        Case Is < LOWEST_UNICODE, Is > HIGHEST_UNICODE
           ' Input Code is not in unicode range, return null string
           ChrWW = vbNullString
        Case Is < SUPPLEMENTARY_UNICODE
           ' Input Code is within range of native VBA function ChrW, so use that instead
           ChrWW = ChrW(Unicode)
        Case Else
           ' Code is on Supplementary Planes, convert to two UTF-16 code units and convert to text using ChrW
           highSurrogate = HIGH_SURROGATE_CONST + ((Unicode - SUPPLEMENTARY_UNICODE) \ TEN_BITS)
           lowSurrogate = LOW_SURROGATE_CONST + ((Unicode - SUPPLEMENTARY_UNICODE) Mod TEN_BITS)
           ChrWW = ChrW(highSurrogate) & ChrW(lowSurrogate)
     End Select

  End Function

For reference on the unicode characters used see here http://www.fileformat.info/info/unicode/block/mathematical_alphanumeric_symbols/list.htm

The wikipedia page on UTF16 shows the algorithm for converting from Unicode to two UTF16 code points

https://en.wikipedia.org/wiki/UTF-16