Logo 
Search:

MS Office Answers

Ask Question   UnAnswered
Home » Forum » MS Office       RSS Feeds
  Question Asked By: Fabiana Ferrrari   on Dec 02 In MS Office Category.

  
Question Answered By: Fadiyah Khan   on Dec 02

I coded this in Excel 2003, but it will work for me.

Sub ColorAndConcatenate()
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

Share: 

 
 


Tagged: