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?
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
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
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
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.