Hi,

I have the following pulled in from Access to Excel and I need to have
it automatically format for a report. This is all in one cell

06Jun for This Many Minutes €“ High/Medium/Low–¡
1700-2240MDT/2300-0440GMT/0700-1240HKG/1100-1640SYD–¡
Description (can be a very long description up to 100 characters)

The first line up to the box character I want to be €˜regular color
index 21. Than on the second line I want the first section before the
slash to be €˜bold, color index 21. Next section after the first
slash I want €˜bold color index 19. After second slash €˜bold
color index 22. After 3rd slash €˜bold color index 18 length 15.
Everything after €˜regular color index 21. So I created below
before I knew the €œfirst€� line was going to be required, but it
will not work because the first line does not have a set amount of
characters like the second. The range for the first line can be
anywhere from 21 to 29 characters. Any ideas? *** FYI, it is not
letting me paste that box character in here because as you know it is
considered a "return" character. So I pasted in a symbol so you could
see what I was. Again all lines are actually in one cell. Here is my
original formula:

Sub Colors()

€˜
€˜
Dim cel As Range

For Each cel In ActiveSheet.Range("f1:f100")
If cel.Value < "" Then
With Selection.Characters(Start:=1, Length:=15).Font
.Name = "Arial"
.FontStyle = "bold"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 21
End With

With Selection.Characters(Start:=16, Length:=15).Font
.Name = "Arial"
.FontStyle = "bold"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 19
End With

With Selection.Characters(Start:=31, Length:=15).Font
.Name = "Arial"
.FontStyle = "bold"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 22
End With

With Selection.Characters(Start:=46, Length:=15).Font
.Name = "Arial"
.FontStyle = "bold"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 18
End With

With Selection.Characters(Start:=60, Length:=155).Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 21
End With
End If

Next cel

End Sub


Thank you so much for the help!!

This code works for the specification given there is very little checking for
string lengths and I leave that for you to havea look at.

'-------------------------------------
Option Explicit

Sub colors_sub(cel As Range, c_start, c_end, font_name, font_bold,
font_size, color_index)
Dim c_length As Long
c_length = c_end - c_start + 1
With cel.Characters(Start:=c_start, Length:=c_length).Font
.Name = font_name
.Bold = font_bold
.Size = font_size
.ColorIndex = color_index
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
End With

End Sub
Sub Colors()

Dim cel As Range

Dim i As Long
Dim ptr_s As Long, ptr_e As Long
On Error Resume Next
For Each cel In ActiveSheet.Range("f1:f100")
For i = 1 To Len(cel.Value)
Debug.Print i, Asc(Mid(cel.Value, i, 1)), Mid(cel.Value, i, 1)
Next i

If cel.Value < "" Then
' set all to be regular
colors_sub cel, 1, Len(cel.Value), "Arial", False, 10, 21

' line 1
ptr_s = 1
ptr_e = InStr(ptr_s, cel.Value, Chr(10), vbBinaryCompare) - 1
colors_sub cel, ptr_s, ptr_e - ptr_s + 1, "Arial", False, 10, 21
' line 2 : sect. 1
ptr_s = ptr_e + 2
ptr_e = InStr(ptr_s, cel.Value, "/", vbBinaryCompare) - 1
colors_sub cel, ptr_s, ptr_e, "Arial", True, 10, 21
' line 2 : sect. 2
ptr_s = ptr_e + 2
ptr_e = InStr(ptr_s, cel.Value, "/", vbBinaryCompare) - 1
colors_sub cel, ptr_s, ptr_e, "Arial", True, 10, 19
' line 2 : sect. 3
ptr_s = ptr_e + 2
ptr_e = InStr(ptr_s, cel.Value, "/", vbBinaryCompare) - 1
colors_sub cel, ptr_s, ptr_e, "Arial", True, 10, 22
' line 2 : sect. 4
ptr_s = ptr_e + 2
ptr_e = InStr(ptr_s, cel.Value, Chr(10), vbBinaryCompare) - 1
colors_sub cel, ptr_s, ptr_e, "Arial", True, 10, 18
' line 3 : this is set at the start
' ptr_s = ptr_e + 2
' ptr_e = Len(cel.Value)
' colors_sub cel, ptr_s, ptr_e, "Arial", True, 10, 18
End If
Next cel
End Sub


--
Hope this helps
Martin Fishlock
Please do not forget to rate this reply.


"mp80237" wrote:

Hi,

I have the following pulled in from Access to Excel and I need to have
it automatically format for a report. This is all in one cell

06Jun for This Many Minutes €“ High/Medium/Low–¡
1700-2240MDT/2300-0440GMT/0700-1240HKG/1100-1640SYD–¡
Description (can be a very long description up to 100 characters)

The first line up to the box character I want to be €˜regular color
index 21. Than on the second line I want the first section before the
slash to be €˜bold, color index 21. Next section after the first
slash I want €˜bold color index 19. After second slash €˜bold
color index 22. After 3rd slash €˜bold color index 18 length 15.
Everything after €˜regular color index 21. So I created below
before I knew the €œfirst€� line was going to be required, but it
will not work because the first line does not have a set amount of
characters like the second. The range for the first line can be
anywhere from 21 to 29 characters. Any ideas? *** FYI, it is not
letting me paste that box character in here because as you know it is
considered a "return" character. So I pasted in a symbol so you could
see what I was. Again all lines are actually in one cell. Here is my
original formula:

Sub Colors()

€˜
€˜
Dim cel As Range

For Each cel In ActiveSheet.Range("f1:f100")
If cel.Value < "" Then
With Selection.Characters(Start:=1, Length:=15).Font
.Name = "Arial"
.FontStyle = "bold"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 21
End With

With Selection.Characters(Start:=16, Length:=15).Font
.Name = "Arial"
.FontStyle = "bold"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 19
End With

With Selection.Characters(Start:=31, Length:=15).Font
.Name = "Arial"
.FontStyle = "bold"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 22
End With

With Selection.Characters(Start:=46, Length:=15).Font
.Name = "Arial"
.FontStyle = "bold"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 18
End With

With Selection.Characters(Start:=60, Length:=155).Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 21
End With
End If

Next cel

End Sub


Thank you so much for the help!!

It worked! Thank you so much for your help!



mp80237 wrote:
Hi,

I have the following pulled in from Access to Excel and I need to have
it automatically format for a report. This is all in one cell

06Jun for This Many Minutes €“ High/Medium/Low–¡
1700-2240MDT/2300-0440GMT/0700-1240HKG/1100-1640SYD–¡
Description (can be a very long description up to 100 characters)

The first line up to the box character I want to be €˜regular color
index 21. Than on the second line I want the first section before the
slash to be €˜bold, color index 21. Next section after the first
slash I want €˜bold color index 19. After second slash €˜bold
color index 22. After 3rd slash €˜bold color index 18 length 15.
Everything after €˜regular color index 21. So I created below
before I knew the €œfirst€� line was going to be required, but it
will not work because the first line does not have a set amount of
characters like the second. The range for the first line can be
anywhere from 21 to 29 characters. Any ideas? *** FYI, it is not
letting me paste that box character in here because as you know it is
considered a "return" character. So I pasted in a symbol so you could
see what I was. Again all lines are actually in one cell. Here is my
original formula:

Sub Colors()

€˜
€˜
Dim cel As Range

For Each cel In ActiveSheet.Range("f1:f100")
If cel.Value < "" Then
With Selection.Characters(Start:=1, Length:=15).Font
.Name = "Arial"
.FontStyle = "bold"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 21
End With

With Selection.Characters(Start:=16, Length:=15).Font
.Name = "Arial"
.FontStyle = "bold"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 19
End With

With Selection.Characters(Start:=31, Length:=15).Font
.Name = "Arial"
.FontStyle = "bold"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 22
End With

With Selection.Characters(Start:=46, Length:=15).Font
.Name = "Arial"
.FontStyle = "bold"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 18
End With

With Selection.Characters(Start:=60, Length:=155).Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 21
End With
End If

Next cel

End Sub


Thank you so much for the help!!