I don't have the time right now to play around with creating a function,
but I do have a macro which will color and concatenate two cells
together.
For your pleasure:
Sub ColorAndConcatenate()
'Concatenates two cells together and returns them
'Formatted. First portion will return in Arial Black 12pts
'While second portion will return in Times New Roman 36pts, Red
Dim intCharFirst As Integer
Dim intCharSec As Integer
Dim strFirst As String
Dim strSecond As String
Do While ActiveCell.Value <> ""
strFirst = ActiveCell.Value
intCharFirst = Len(strFirst)
'Move to next cell in list
ActiveCell.Offset(1, 0).Range("A1").Select
strSecond = ActiveCell.Value
intCharSec = Len(strSecond)
'Move to next cell in list
ActiveCell.Offset(1, 0).Range("A1").Select
'Concatenate cells together
ActiveCell.Value = strFirst & strSecond
'Format the New Cell
'First Part
ActiveCell.FormulaR1C1 = strFirst & strSecond
With ActiveCell.Characters(Start:=1, _
Length:=intCharFirst).Font
.Name = "Arial Black"
.FontStyle = "Regular"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
'Second Part
With ActiveCell.Characters(Start:=intCharFirst + 1, _
Length:=intCharSec).Font
.Name = "Times New Roman"
.FontStyle = "Regular"
.Size = 36
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 3
End With
'Reset Variables
strFirst = ""
strSecond = ""
intCharFirst = 0
intCharSec = 0
'Move to next cell in list
ActiveCell.Offset(1, 0).Range("A1").Select
Loop
End Sub