Copy partial cell character format(s) from one cell to another - an example

[aztecbrainsurgeon]

Hello,
No question here just a procedure for the archive.

Sub CopyInternalCellFormatToOtherCells()

'Copy the full or partial internal format of a cell to other targeted
cells.

'Procedure is meant to copy formats that the Excel Format Painter
cannot
'transfer to other cells (e.g., partial italics of cell contents- some
characters are
italicized and other characters are not).

Dim TargetCell, TargetRange As Range
Dim i As Integer

On Error Resume Next
Set TargetCell = Application.InputBox( _
prompt:="Select ONE Cell to Copy Its Format to
other Cells ", Type:=8)
Set TargetRange = Application.InputBox( _
prompt:="Select Cells You Wish to Format",
Type:=8)

'Check for empty value or empty range selection for TargetCell
If IsEmpty(TargetCell.Value) Then
Exit Sub
End If



For i = 1 To Len(TargetCell.Value)

'Test each character in TargetCell to see if it meets criteria
below:
'Note: currently this test is for just one condition. You could
test
'for two or more conditions by using an "AND" statement in
conjunction
'with the type of character formatting you desire.

If TargetCell.Characters(Start:=i, Length:=1).Font.FontStyle =
"Bold" Then

'If criteria is met, apply format(s) specified below to all
characters
'in TargetRange in same position of character in TargetCell
'Edit formatting application as desired below:

For Each cell In TargetRange
With cell.Characters(Start:=i, Length:=1).Font
' .Name = "Arial"
.FontStyle = "Bold"
'"Regular" or "Bold Italic"
' .Size = 10
' .Strikethrough = False
' .Superscript = False
' .Subscript = False
' .OutlineFont = False
' .Shadow = False
' .Underline =
xlUnderlineStyleNone
' .ColorIndex = xlAutomatic
End With
Next cell
End If

Next i

End Sub

search criteria: copy partial cell formatting partial cell format
painter limitation
copy partial cell formats from one cell to another cell format
limitation mass cell formatting
overcome format painter limitation solution