Multiple Formats In The Same Cell

[Guest]

Good evening

I have data in various cells in columns D to H in a spreadsheet. Where
there is data it is in 3 parts separated by a "+" and "-".

I want to write a macro which scrolls down and in each cell where there is
data I want to format everything to the left of the "+" Bold, Arial 10, Blue,
everything to the right of the - Arial 8, Black and everything between the
"+" and the "-" Arial 8, Red.

Whilst it is possible to manually format each cell I haven't been able to
make Conditional Formatting work with this but that could be because I had
the syntax of the formula wrong.

Is it possible to achieve this with a macro and if so please can I have some
help with the code.

Many thanks in anticipation

Kewa

 

[Gary Keramidas]

this may get you started

Sub test()
Dim ws As Worksheet
Dim rng As Range
Dim cell As Range
Dim p1 As Long, p2 As Long

Set ws = Worksheets("Sheet1")
Set rng = ws.Range("D1:H500")

On Error Resume Next
For Each cell In rng
p1 = InStr(cell, "+")
p2 = InStrRev(cell, "-")
With cell.Characters(1, p1 - 1)
.Font.Bold = True
.Font.Name = "Arial"
.Font.Size = 10
.Font.ColorIndex = 5
End With

With cell.Characters(p1 + 1, Len(cell) - p2)
.Font.Name = "Arial"
.Font.Size = 8
.Font.ColorIndex = 0
End With
With cell.Characters(p2 + 1, Len(cell) - p2)
.Font.Name = "Arial"
.Font.Size = 8
.Font.ColorIndex = 3
End With
Next
On Error GoTo 0
End Sub

 

[Guest]

Sub Macro1()
'
' Macro1 Macro
' Macro recorded 7/29/2007 by Joel
'

'
PosPosition = InStr(ActiveCell, "+")
NegPosition = InStr(ActiveCell, "-")

With ActiveCell.Characters(Start:=1, _
Length:=(PosPosition - 1)).Font
.Bold = True
.Size = 10
.ColorIndex = 5
.Name = "Arial"
End With
With ActiveCell.Characters( _
Start:=PosPosition + 1, _
Length:=((NegPosition - PosPosition) - 1)).Font
.Bold = False
.Size = 8
.ColorIndex = 1
.Name = "Arial"
End With
With ActiveCell.Characters( _
Start:=NegPosition + 1, _
Length:=(Len(ActiveCell) - NegPosition)).Font
.Bold = False
.Size = 8
.ColorIndex = 3
.Name = "Arial"
End With

End Sub

 

[Peter T]

Another one -

Sub test2()
Dim pos1 As Long, pos2 As Long
Dim rng As Range, cel As Range
' all Arial
' LLL+MMM-RRR
' LLL blue, bold-true 10
' MMM red, bold-false,8
' RRR and +/- auto/black, bold-false, 8

On Error Resume Next

Set rng = Range("D:H").SpecialCells(xlCellTypeConstants, 2)
If rng Is Nothing Then Exit Sub

If rng.Count > 10 Then
Application.ScreenUpdating = False
End If

For Each cel In rng

pos1 = InStr(2, cel, "+")
pos2 = InStr(pos1 + 1, cel, "-")

If pos1 Or pos2 Then
With cel.Font
.Name = "Arial"
.Size = 8
.ColorIndex = xlAutomatic
.Bold = False
End With
End If

If pos1 Then
With cel.Characters(1, pos1 - 1).Font
.Size = 10
.ColorIndex = 5
'' if possibility of non default palette use
' .Color = &HFF0000
.Bold = True
End With
End If

If pos2 > 1 Then
cel.Characters(pos1 + 1, pos2 - pos1 - 1).Font.ColorIndex = 3
' or .Color = &HFF
End If
Next

If Application.ScreenUpdating = False Then
Application.ScreenUpdating = True
End If

End Sub

Regards,
Peter T