Characters Object limitation?

[Kobus]

It seems that the "characters object" in Excel has a limitation of 256
characters. The object allows you to access, insert or delete
characters from a cell without affecting the rich text formatting. It
however only works of the cell contains 256 or less characters
otherwise it does nothing and does not give an error message.
Is there another object that can access all the characters in a cell
while still preserving the rich text formatting? Obviously there is
such an object (otherwise Excel itself would not be able to function
correctly) but how do one access it?

 

[Guest]

The 256 character limitation is relative to the extended ASCII character set.
Unicode offers a much greater selection of characters but has not yet been
incorporated into the Excel infrastructure.

 

[Peter T]

I suspect this 255 limit (not 256) relates to the Insert method rather than
the Characters object. No problem to apply mixed formats up to 1024.

To insert text in a cell of text over 255 would need to slice the existing
string, eg

Sub test()
Dim s1$, s2$
Dim r As Range

Set r = Range("B2")

r = Application.Rept("A", 300) & Application.Rept("B", 300)

s1 = Left$(r, 200): s2 = Mid$(r, 201, 1000)
r = s1 & "-NEW STRING-" & s2

With r.Characters(201, 12).Font
.ColorIndex = 3
.Bold = True
End With

Debug.Print Len(r), r.Characters.Count

End Sub

To preserve existing mixed formats would require storing them all first then
reapplying, tedious stuff!

JLGWhiz, not sure how the ASCII character set relates to this issue

Regards
Peter T

 

[Kobus]

I suspect this 255 limit (not 256) relates to the Insert method rather than
the Characters object. No problem to apply mixed formats up to 1024.

To insert text in a cell of text over 255 would need to slice the existing
string, eg

Sub test()
Dim s1$, s2$
Dim r As Range

Set r = Range("B2")

r = Application.Rept("A", 300) & Application.Rept("B", 300)

s1 = Left$(r, 200): s2 = Mid$(r, 201, 1000)
r = s1 & "-NEW STRING-" & s2

With r.Characters(201, 12).Font
.ColorIndex = 3
.Bold = True
End With

Debug.Print Len(r), r.Characters.Count

End Sub

To preserve existing mixed formats would require storing them all first then
reapplying, tedious stuff!

JLGWhiz, not sure how the ASCII character set relates to this issue

Regards
Peter T






- Show quoted text -

The storing of the formats only works up to 256 characters e.g. the
following type of code can only see up to 256 characters i.e. n should
not be larger than 256:
ActiveCell.Characters(n, 1)
Even the tedious method does not work.

 

[Peter T]

The storing of the formats only works up to 256 characters e.g. the
following type of code can only see up to 256 characters i.e. n should
not be larger than 256:
ActiveCell.Characters(n, 1)
Even the tedious method does not work.

Why not. The above example successfully applied font format to
characters(201,12) for me. Also you can return the formats and store them,
add this after the End With in my example

MsgBox r.Characters(201, 12).Font.ColorIndex ' 3 red

Regards,
Peter T

 

[Tom Ogilvy]

seeings believing:

Sub ABCD()
'Dim rng As Range, i As Long
For i = 1089 To 1093
With Range("B2")
.Characters(i, 1).Font.Bold = True
End With
Next
With Range("B2").Characters(1089, 5).Font
.Italic = True
.Name = "Times New Roman"
.ColorIndex = 3
End With
Set rng = Range("B2")
Debug.Print Len(rng) & " <=== length of the string "
For i = 1087 To 1095
With rng
Debug.Print i, .Characters(i, 1).Text, _
.Characters(i, 1).Font.Bold, _
.Characters(i, 1).Font.Italic, _
.Characters(i, 1).Font.ColorIndex, _
.Characters(i, 1).Font.Name
End With
Next
End Sub

Productes

1106 <=== length of the string
1087 d False False -4105 Arial
1088 False False -4105 Arial
1089 c True True 3 Times
New Roman
1090 h True True 3 Times
New Roman
1091 u True True 3 Times
New Roman
1092 c True True 3 Times
New Roman
1093 k True True 3 Times
New Roman
1094 False False -4105 Arial
1095 w False False -4105 Arial

So I couldn't reproduce the limitation.

 

[Kobus]

seeings believing:

Sub ABCD()
'Dim rng As Range, i As Long
For i = 1089 To 1093
With Range("B2")
.Characters(i, 1).Font.Bold = True
End With
Next
With Range("B2").Characters(1089, 5).Font
.Italic = True
.Name = "Times New Roman"
.ColorIndex = 3
End With
Set rng = Range("B2")
Debug.Print Len(rng) & " <=== length of the string "
For i = 1087 To 1095
With rng
Debug.Print i, .Characters(i, 1).Text, _
.Characters(i, 1).Font.Bold, _
.Characters(i, 1).Font.Italic, _
.Characters(i, 1).Font.ColorIndex, _
.Characters(i, 1).Font.Name
End With
Next
End Sub

Productes

1106 <=== length of the string
1087 d False False -4105 Arial
1088 False False -4105 Arial
1089 c True True 3 Times
New Roman
1090 h True True 3 Times
New Roman
1091 u True True 3 Times
New Roman
1092 c True True 3 Times
New Roman
1093 k True True 3 Times
New Roman
1094 False False -4105 Arial
1095 w False False -4105 Arial

So I couldn't reproduce the limitation.

--
Regards,
Tom Ogilvy







- Show quoted text -

You are right about the fonts but I still experience the limation with
the delete method. The following code does not work if the number
characters in "B2" is more than 256:
Range("B2").Characters(150,5).delete

 

[Tom Ogilvy]

I didn't even know it had a delete method <g> - when I think of characters,
I don't think of delete. - I always use other methods. Sounds like you
would need to use the tedious method.

 

[Guest]

I'm running into this exact problem where the .Insert method of the
Characters Object doesn't work on a string greater than 255 characters (nor
does it give an error, it just behaves as if it works and keeps on going)...
and where splitting the string and adding the new characters loses all
existing rich text formatting. If the only way to make this work is to do as
you suggested and store all of the data and metadata first, would you have
any pointers or suggestions on how to get started doing this? Do I parse the
string into some sort of an array?

I read all the way down into Tom's responses as well but I didn't see an
answer though he said he uses other methods... so if anyone has a suggestion
as to how to insert new characters into a field with greater than 255
characters while preserving existing rich text formatting, your input would
be greatly appreciated.

 

[Peter T]

As I said, it's tedious!

This example is quite long so only colour, bold & italic handled, but easy
to extend to cater for the other formats. It could be done with a fraction
of the code but would take a long time to process with a long string (no
mixed formats over 1024).

As written there's a slight difference in how the Insert method handles
formats with new 'replaced' text vs code as written. Comment out the 'If
less 256' stuff to see the difference.

Note the 'Insert method (limited to 255) is actually insert and replace.
This example gives the 'replace' as an option. Also another option to delete
n characters or first instance of a string.

It needs testing far more than I've yet done and if needs correcting. (If
something becomes apparent in the future drop me a line with the
correction.)

Sub InsertMixed(cell As Range, sText As String, nStart As Long, _
Optional bReplace As Boolean, Optional nDelete As Long)
' Insert (or replace) or delete text and conserve mixed font formats
' pmbthornton at gmail dot com

' bReplace -
' false, insert in between existing text
' true, replace same length existing text
' nDelete = true -
' sText = "" to delete nDelete char's from nStart
' sText = "string" with nDelete a number to delete 1 intst' of "string"

Dim i As Long, n As Long
Dim nLen As Long
Dim nC As Long, nB As Long, nI As Long ' color, bold, italic, (temp
counters)
Dim nU&, nS&, nT&, nZ&, nN& 'underline, sub/super script, font size/name

Dim nInsLen As Long, nPos As Long
Dim s$, sL$, sR$
Dim v

s = cell
nLen = Len(s)
If nLen = 0 Then
If Not bDelete Then
rng = sText
End If
Exit Sub
End If

nInsLen = Len(sText)

If nDelete Then
If Len(sText) Then
nPos = InStr(1, s, sText, vbTextCompare)
If nPos = 0 Then Exit Sub
nInsLen = Len(sText)
nDelete = nInsLen
Else
nInsLen = nDelete
End If
nInsLen = -nDelete
sText = ""
bReplace = 0 'True
End If

If nStart = 0 Then nStart = 1

If nLen + nInsLen < 256 And (bReplace Or nDelete > 0) Then
If nDelete > 0 Then
cell.Characters(nStart, Abs(nInsLen)).Delete
Else
cell.Characters(nStart, nInsLen).Insert sText
End If

Exit Sub
End If


' 3-d array a()
' 1st - position
' 2nd - color, bold, italic
' 3rd - format, length if first change of format else 0

' Increase the 2nd dim to include other formats
' eg - underline, super/sub-script, font size/name
' and use the other temp counters like nU for underline

ReDim a(1 To nLen + nInsLen, 1 To 3, 1 To 2)

If nStart = 1 And bReplace = False Then
n = nInsLen + 1
Else: n = 1
End If


With cell.Font
' if a format is not mixed no need to waste time
' checking each character in the loop
v = .ColorIndex: If Not IsNull(v) Then nC = nLen
v = .Bold: If Not IsNull(v) Then nB = nLen
v = .Italic: If Not IsNull(v) Then nI = nLen
End With

' store the formats
With cell.Characters(1, 1).Font
' start with the first charachter
a(n, 1, 1) = .ColorIndex:
If nC = 0 Then
a(n, 1, 2) = 1: nC = n
Else
a(n, 1, 2) = nC: nC = -1
End If

a(n, 2, 1) = .Bold
If nB = 0 Then
a(n, 2, 2) = 1: nB = n
Else
a(n, 2, 2) = nB: nB = -1
End If

a(n, 3, 1) = .Italic
If nI = 0 Then
a(n, 3, 2) = 1: nI = n
Else
a(n, 3, 2) = nI: nI = -1
End If
End With

For i = 2 To nLen
'loop the rest
n = n + 1
If i = nStart And bReplace = False Then
n = n + nInsLen
If nC > 0 Then a(nC, 1, 2) = a(nC, 1, 2) + nInsLen
If nB > 0 Then a(nB, 2, 2) = a(nB, 2, 2) + nInsLen
If nI > 0 Then a(nI, 3, 2) = a(nI, 3, 2) + nInsLen
End If

With cell.Characters(i, 1).Font
If nC > -1 Then
a(n, 1, 1) = .ColorIndex
If a(n, 1, 1) = a(nC, 1, 1) Then
a(nC, 1, 2) = a(nC, 1, 2) + 1
Else
nC = n: a(n, 1, 2) = 1
End If
End If
If nB > -1 Then
a(n, 2, 1) = .Bold
If a(n, 2, 1) = a(nB, 2, 1) Then
a(nB, 2, 2) = a(nB, 2, 2) + 1
Else
nB = n: a(n, 2, 2) = 1
End If
End If
If nI > -1 Then
a(n, 3, 1) = .Italic
If a(n, 3, 1) = a(nI, 3, 1) Then
a(nI, 3, 2) = a(nI, 3, 2) + 1
Else
nI = n: a(n, 3, 2) = 1
End If
End If
' other formats here
End With
Next

' slice the string
If nDelete > 0 Then
If nStart = 1 Then
s = sText & Mid$(s, Abs(nInsLen) + 1, nLen)
ElseIf nStart > nLen Then
s = Left$(s, nLen - Abs(nInsLen)) & sText
Else
sL = Left$(s, nStart - 1)
sR = Mid$(s, nStart + Abs(nInsLen), nLen)
s = sL & sText & sR
End If

ElseIf bReplace Then
If nStart = 1 Then
s = sText & Mid$(s, nInsLen + 1, nLen)
ElseIf nStart > nLen Then
s = Left$(s, nLen - nInsLen) & sText
Else
sL = Left$(s, nStart - 1)
sR = Mid$(s, nStart + nInsLen, nLen)
s = sL & sText & sR
End If
Else

If nStart = 1 Then
s = sText & s
ElseIf nStart > nLen Then
s = s & sText
Else
sL = Left$(s, nStart - 1)
sR = Mid$(s, nStart, nLen)
s = sL & sText & sR
End If
End If

' dump the new string
cell = s

If nStart = 1 And bReplace = False Then
n = nInsLen
Else: n = 0
nLen = Len(s)
End If

' replace the formats
For i = 1 To nLen
n = n + 1
If a(n, 1, 2) And a(n, 1, 2) <> nLen - n Then
cell.Characters(n, a(n, 1, 2)).Font.ColorIndex = a(n, 1, 1)
End If
If a(n, 2, 2) And a(n, 2, 2) <> nLen - n Then
cell.Characters(n, a(n, 2, 2)).Font.Bold = a(n, 2, 1)
End If
If a(n, 3, 2) And a(n, 3, 2) <> nLen - n Then
cell.Characters(n, a(n, 3, 2)).Font.Italic = a(n, 3, 1)
End If
' other formats here
Next

End Sub

Regards,
Peter T

 

[Peter T]

Oops, something I added at the last minute without testing

change -

If nLen = 0 Then
If Not bDelete Then
rng = sText
End If
Exit Sub
End If

to -
If nLen = 0 Then
If Not nDelete Then
cell = sText
End If
Exit Sub
End If

Might as well have this as a starter to test the routine -

Sub test()
Dim R As Range
Dim n As Long, i As Long

Range("A1:A40").Clear

Set R = Range("A1")

' the short strings test the Insert/Delete method under 256
For i = 0 To 1
If i = 0 Then n = 20 Else n = 200
R = Application.Rept("A", n) & Application.Rept("B", n)

R.Characters(1, 3).Font.Bold = True
R.Characters(2 * n - 2, 3).Font.Bold = True
R.Characters(n - 2, 3).Font.ColorIndex = 3
R.Characters(n + 1, 3).Font.ColorIndex = 5
R.Copy R.Offset(1, 0)

R.Offset(2, 0) = "Insert between (not replace) at " & n + 1 ',
short & long string
InsertMixed R.Offset(1, 0), "NEW_STRING", n + 1, False, 0
Set R = R.Offset(4, 0)
Next

For i = 0 To 1
If i = 0 Then n = 20 Else n = 200
R = Application.Rept("A", n) & Application.Rept("B", n)
R.Font.Bold = False
R.Characters(1, 3).Font.Bold = True
R.Characters(2 * n - 2, 3).Font.Bold = True
R.Characters(n - 2, 3).Font.ColorIndex = 3
R.Characters(n + 1, 13).Font.ColorIndex = 5
R.Copy R.Offset(1, 0)

R.Offset(2, 0) = "Insert AND replace over existing at " & n + 1
InsertMixed R.Offset(1, 0), "NEW_STRING", n + 1, True, 0
Set R = R.Offset(4, 0)

Next

For i = 0 To 1
If i = 0 Then n = 20 Else n = 200
R = Application.Rept("A", n) & "zzz" & Application.Rept("B", n)
R.Font.Bold = False
R.Characters(1, 3).Font.Bold = True
R.Characters(2 * n - 2 + 3, 3).Font.Bold = True
R.Characters(n - 2, 3).Font.ColorIndex = 3
R.Characters(n + 1 + 3, 3).Font.ColorIndex = 5
R.Copy R.Offset(1, 0)

R.Offset(2, 0) = "delete the 'zzz' at " & n + 1
InsertMixed R.Offset(1, 0), "", n + 1, True, 3
Set R = R.Offset(4, 0)
Next

For i = 0 To 1
If i = 0 Then n = 20 Else n = 200
R = Application.Rept("A", n) & "delete_me" & Application.Rept("B",
n)
R.Font.Bold = False
R.Characters(1, 3).Font.Bold = True
R.Characters(2 * n - 2 + 9, 3).Font.Bold = True
R.Characters(n - 2, 3).Font.ColorIndex = 3
R.Characters(n + 1 + 9, 3).Font.ColorIndex = 5
R.Copy R.Offset(1, 0)

R.Offset(2, 0) = "delete 1st instance of 'delete-me' "
InsertMixed R.Offset(1, 0), "delete_me", n + 1, True, 1
Set R = R.Offset(4, 0)
Next

End Sub

Peter T

 

[Peter T]

Replaced formats weren't quite right with 'delete', some minor changes -


Sub InsertMixed1(cell As Range, sText As String, nStart As Long, _
Optional bReplace As Boolean, Optional nDelete As Long)
' Insert (or replace) or delete text and conserve mixed font formats
' pmbthornton at gmail dot com

' bReplace -
' false, insert in between existing text
' true, replace same length existing text
' nDelete = true -
' sText = "" to delete nDelete char's from nStart
' sText = "string" with nDelete a number to delete 1 intst' of "string"

Dim i As Long, n As Long
Dim nLen As Long
Dim nC As Long, nB As Long, nI As Long ' color, bold, italic, (temp
counters)
Dim nU&, nS&, nT&, nZ&, nN& 'underline, sub/super script, font size/name

Dim nInsLen As Long, nPos As Long
Dim s As String, sL As String, sR As String
Dim v

s = cell
nLen = Len(s)
If nLen = 0 Then
If nDelete = 0 Then
cell = sText
End If
Exit Sub
End If

nInsLen = Len(sText)

If nDelete Then
If Len(sText) Then
nPos = InStr(1, s, sText, vbTextCompare)
If nPos = 0 Then Exit Sub
nDelete = Len(sText)
End If

nInsLen = nDelete
sText = ""
bReplace = False
End If

If nStart = 0 Then nStart = 1

If nLen + nInsLen < 256 And (bReplace Or nDelete > 0) Then
If nDelete > 0 Then
cell.Characters(nStart, nInsLen).Delete
Else
cell.Characters(nStart, nInsLen).Insert sText
End If

Exit Sub
End If


' 3-d array a()
' 1st - position
' 2nd - color, bold, italic
' 3rd - format, length if first change of format else 0

' Increase the 2nd dim to include other formats
' eg - underline, super/sub-script, font size/name
' and use the other temp counters like nU for underline

ReDim a(1 To nLen + nInsLen, 1 To 3, 1 To 2)

If nStart = 1 And bReplace = False Then
n = nInsLen + 1
Else: n = 1
End If


With cell.Font
' if a format is not mixed no need to waste time
' checking each character in the loop
v = .ColorIndex: If Not IsNull(v) Then nC = nLen
v = .Bold: If Not IsNull(v) Then nB = nLen
v = .Italic: If Not IsNull(v) Then nI = nLen
End With


With cell.Characters(1, 1).Font
' start with the first charachter
a(n, 1, 1) = .ColorIndex:
If nC = 0 Then
a(n, 1, 2) = 1: nC = n
Else
a(n, 1, 2) = nC: nC = -1
End If

a(n, 2, 1) = .Bold
If nB = 0 Then
a(n, 2, 2) = 1: nB = n
Else
a(n, 2, 2) = nB: nB = -1
End If

a(n, 3, 1) = .Italic
If nI = 0 Then
a(n, 3, 2) = 1: nI = n
Else
a(n, 3, 2) = nI: nI = -1
End If
End With

For i = 2 To nLen
'loop the rest
n = n + 1
If i = nStart And bReplace = False Then
If nDelete Then
i = i + nInsLen
Else
n = n + nInsLen
If nC > 0 Then a(nC, 1, 2) = a(nC, 1, 2) + nInsLen
If nB > 0 Then a(nB, 2, 2) = a(nB, 2, 2) + nInsLen
If nI > 0 Then a(nI, 3, 2) = a(nI, 3, 2) + nInsLen
End If
End If

With cell.Characters(i, 1).Font
If nC > -1 Then
a(n, 1, 1) = .ColorIndex
If a(n, 1, 1) = a(nC, 1, 1) Then
a(nC, 1, 2) = a(nC, 1, 2) + 1
Else
nC = n: a(n, 1, 2) = 1
End If
End If
If nB > -1 Then
a(n, 2, 1) = .Bold
If a(n, 2, 1) = a(nB, 2, 1) Then
a(nB, 2, 2) = a(nB, 2, 2) + 1
Else
nB = n: a(n, 2, 2) = 1
End If
End If
If nI > -1 Then
a(n, 3, 1) = .Italic
If a(n, 3, 1) = a(nI, 3, 1) Then
a(nI, 3, 2) = a(nI, 3, 2) + 1
Else
nI = n: a(n, 3, 2) = 1
End If
End If
' other formats here
End With
Next

' slice the string
If nDelete > 0 Then
If nStart = 1 Then
s = sText & Mid$(s, nInsLen + 1, nLen)
ElseIf nStart > nLen Then
s = Left$(s, nLen - nInsLen) & sText
Else
sL = Left$(s, nStart - 1)
sR = Mid$(s, nStart + nInsLen, nLen)
s = sL & sText & sR
End If

ElseIf bReplace Then
If nStart = 1 Then
s = sText & Mid$(s, nInsLen + 1, nLen)
ElseIf nStart > nLen Then
s = Left$(s, nLen - nInsLen) & sText
Else
sL = Left$(s, nStart - 1)
sR = Mid$(s, nStart + nInsLen, nLen)
s = sL & sText & sR
End If
Else

If nStart = 1 Then
s = sText & s
ElseIf nStart > nLen Then
s = s & sText
Else
sL = Left$(s, nStart - 1)
sR = Mid$(s, nStart, nLen)
s = sL & sText & sR
End If
End If

' dump the new string
cell = s

If nStart = 1 And bReplace = False Then
n = nInsLen
Else: n = 0
nLen = Len(s)
End If

' replace the formats
For i = 1 To nLen
n = n + 1
If a(n, 1, 2) And a(n, 1, 2) <> nLen - n Then
cell.Characters(n, a(n, 1, 2)).Font.ColorIndex = a(n, 1, 1)
End If
If a(n, 2, 2) And a(n, 2, 2) <> nLen - n Then
cell.Characters(n, a(n, 2, 2)).Font.Bold = a(n, 2, 1)
End If
If a(n, 3, 2) And a(n, 3, 2) <> nLen - n Then
cell.Characters(n, a(n, 3, 2)).Font.Italic = a(n, 3, 1)
End If
' other formats here
Next

End Sub

Peter T

As I said, it's tedious!

This example is quite long so only colour, bold & italic handled, but easy
to extend to cater for the other formats. It could be done with a fraction
of the code but would take a long time to process with a long string (no
mixed formats over 1024).

As written there's a slight difference in how the Insert method handles
formats with new 'replaced' text vs code as written. Comment out the 'If
less 256' stuff to see the difference.

Note the 'Insert method (limited to 255) is actually insert and replace.
This example gives the 'replace' as an option. Also another option to delete
n characters or first instance of a string.

It needs testing far more than I've yet done and if needs correcting. (If
something becomes apparent in the future drop me a line with the
correction.)

<snip>