Retain Font Formats After Changing An Excel Shape’s Formula
This is a frustration I seem to always face while creating dashboards or graphics for Excel reports. I create a super cool callout graphic to bring attention to an important figure in my data. I have this graphic perfectly formatted and proceed to copy it a couple of times to link some more important figures to these callouts. In my example below, I started with the “Ohio” and linked it to some cells to make it dynamic. I then proceeded to copy it twice to create a callout for the states of Iowa and Maine.
The problem arises when you go and try to adjust the shape or textbox formulas to a link to a different cell address. For some reason, Excel wants to reset the the font format after a formula change. Then the pain begins…you have to go back and reformat each of the graphics (either manually or with the Format Painter button). What a pain in the butt!
A Solution To Prevent This
After running into this issue for quite some time and failing to find any solution on the internet, I did what any VBA coder would do….create a solution from scratch. With the macro solution I drew up, you can select the shape you want to adjust and modify cell address link while maintaining the text formats.
The Magic Trick: The VBA code stores the font formats before the formula gets changed and then re-applies the formats to the shape.
The VBA Macro Solution
Below is the code I came up with and use on a regular basis while creating graphics and callouts that need to display data. All you need to do is copy this code into your Personal Macro workbook and then you can access it whenever you need it (I have this macro placed in my Quick Access Toolbar or QAT also).
Sub LinkShape_RetainFormat()
'PURPOSE: Prevent The Resetting Of Font Format When Changing An Excel Shape's Formula
'SOURCE: www.TheSpreadsheetGuru.com
Dim shp As Shape
Dim LinkCell As Range
Dim FontBold As Boolean
Dim FontItalic As Boolean
Dim FontColor As Long
Dim FontSize As Long
Dim FontUnderline As Long
Dim FontName As String
Dim myAnswer As Variant
'Determine If Selection Is A Shape
On Error GoTo InvalidSelection
Set shp = ActiveSheet.Shapes(Selection.Name)
On Error GoTo 0
'Store Current Font Settings
With Selection.ShapeRange.TextFrame2.TextRange.Font
FontBold = .Bold
FontColor = .Fill.ForeColor
FontSize = .Size
FontItalic = .Italic
FontUnderline = .UnderlineColor
FontName = .Name
End With
'Ask User For New Cell To Link To
On Error GoTo UserCancelled
Set LinkCell = Application.InputBox("Select a single cell to link to", Type:=8)
On Error GoTo 0
'Change Shape's Cell Link
If LinkCell.Parent.Name = ActiveSheet.Name Then
Selection.Formula = "=" & LinkCell.Cells(1, 1).Address
Else
Selection.Formula = "='" & LinkCell.Parent.Name & "'!" & LinkCell.Cells(1, 1).Address
End If
'Restore Original Font Settings
With Selection.ShapeRange.TextFrame2.TextRange.Font
.Bold = FontBold
.Fill.ForeColor.RGB = FontColor
.Size = FontSize
.Italic = FontItalic
.UnderlineColor = FontUnderline
.Name = FontName
End With
'Scroll Back to Selected Shape
myAnswer = MsgBox("Scroll back to graphic location?", vbYesNo)
If myAnswer = vbYes Then
ActiveWindow.ScrollColumn = Selection.TopLeftCell.Column
ActiveWindow.ScrollRow = Selection.TopLeftCell.Row
End If
Exit Sub
'ERROR HANDLERS
InvalidSelection:
MsgBox "Please select a shape object before running this code"
Exit Sub
UserCancelled:
Exit Sub
End Sub[Optional] Auto-Populate Current Linked Cell
Below is the same macro as above but with one modification that I found to be useful. It auto-populates the input box with the current formula address. This can be useful if you data is located far away from where your graphic resides. This is because the input box will automatically navigate you to where the cell location is visually. Try it out!
Sub LinkShape_RetainFormat2()
'PURPOSE: Prevent The Resetting Of Font Format When Changing An Excel Shape's Formula
'SOURCE: www.TheSpreadsheetGuru.com
Dim shp As Shape
Dim LinkCell As Range
Dim FontBold As Boolean
Dim FontItalic As Boolean
Dim FontColor As Long
Dim FontSize As Long
Dim FontUnderline As Long
Dim FontName As String
Dim myAnswer As Variant
'Determine If Selection Is A Shape
On Error GoTo InvalidSelection
Set shp = ActiveSheet.Shapes(Selection.Name)
On Error GoTo 0
'Store Current Font Settings
With Selection.ShapeRange.TextFrame2.TextRange.Font
FontBold = .Bold
FontColor = .Fill.ForeColor
FontSize = .Size
FontItalic = .Italic
FontUnderline = .UnderlineColor
FontName = .Name
End With
'Ask User For New Cell To Link To (Default To Current Formula)
On Error GoTo UserCancelled
Set LinkCell = Application.InputBox("Select a single cell to link to", _
Type:=8, Default:=Selection.Formula)
On Error GoTo 0
'Change Shape's Cell Link
If LinkCell.Parent.Name = ActiveSheet.Name Then
Selection.Formula = "=" & LinkCell.Cells(1, 1).Address
Else
Selection.Formula = "='" & LinkCell.Parent.Name & "'!" & LinkCell.Cells(1, 1).Address
End If
'Restore Original Font Settings
With Selection.ShapeRange.TextFrame2.TextRange.Font
.Bold = FontBold
.Fill.ForeColor.RGB = FontColor
.Size = FontSize
.Italic = FontItalic
.UnderlineColor = FontUnderline
.Name = FontName
End With
'Scroll Back to Selected Shape
myAnswer = MsgBox("Scroll back to graphic location?", vbYesNo)
If myAnswer = vbYes Then
ActiveWindow.ScrollColumn = Selection.TopLeftCell.Column
ActiveWindow.ScrollRow = Selection.TopLeftCell.Row
End If
Exit Sub
'ERROR HANDLERS
InvalidSelection:
MsgBox "Please select a shape object before running this code"
Exit Sub
UserCancelled:
Exit Sub
End SubDownload An Example File
If you need a little head start or are not comfortable with VBA quite yet, I have put together a great little example Excel file with some of the examples covered in this article.
If you would like to get a copy of the Excel file I used throughout this article, feel free to directly download the spreadsheet by clicking the download button below.
Learn my best Excel chart design hacks. These will turn your ugly charts into professionally crafted graphics, leaving your boss speechless!!!
Keep Learning
Chris Newman
Chris is a finance professional and Excel MVP recognized by Microsoft since 2016. With his expertise, he founded TheSpreadsheetGuru blog to help fellow Excel users, where he shares his vast creative solutions & expertise. In addition, he has developed over 7 widely-used Excel Add-ins that have been embraced by individuals and companies worldwide.