I had a similar project years ago. This is what I came up with....
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
End With
'Second Part
With ActiveCell.Characters(Start:=intCharFirst + 1, _
Length:=intCharSec).Font
.Name = "Times New Roman"
.FontStyle = "Regular"
.Size = 36
.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
Dawn Bleuel
Posted by: dlbleuel@gmail.com
| Reply via web post | • | Reply to sender | • | Reply to group | • | Start a New Topic | • | Messages in this topic (5) |
Be sure to check out TechTrax Ezine for many, free Excel VBA articles! Go here: http://www.mousetrax.com/techtrax to enter the ezine, then search the ARCHIVES for EXCEL VBA.
----------------------------------
Visit our ExcelVBA group home page for more info and support files:
http://groups.yahoo.com/group/ExcelVBA
----------------------------------
More free tutorials and resources available at:
http://www.mousetrax.com
----------------------------------
Tidak ada komentar:
Posting Komentar