Thread: Parsing Characters - Bug ???

I have a complex macro that parses characters in the active cell and makes
changes to the worksheet. However, if the macro is run after opening the wb
before any manual cell entry is made (as opposed to clearing contents or
pasting etc.) then the macro runs very slowly. This is obvious if there is a
lot of text in the cell being parsed. However, as soon as a manual cell entry
is made to any cell in the wb the same macro takes roughly 15% as much time.
Programmatic cell entry doesn't work unless using Sendkeys.

Below is a macro that doesn't do anything meaningful except demo the
problem. Note the commented text which is a kludge that works but, suffice to
say, I would like to avoid in the real macro. It should be run with the
active cell containing some miscellaneous text of about 200 characters.
Expected run time ~12 sec. or ~2.5 sec. depending on if cell entry made. The
active cell should not be in the first column if you run the Sendkeys kludge.

Sub Testxyz()
Dim char As Characters
Dim c As Range
Dim i As Integer, ii As Long
Dim tmr As Long

Application.ScreenUpdating = False
Set c = ActiveCell
'Application.SendKeys "+{TAB}x{TAB}"
'DoEvents
tmr = Timer
For i = 1 To Len(c) - 1
Set char = c.Characters(i, 1)
For ii = i + 1 To Len(c)
If Mid(c, ii, 1) = char.Text Then
c(2) = c(2) & char.Text
End If
Next ii
Next i
Application.ScreenUpdating = True
MsgBox (Timer - tmr)
End Sub

Very appreciative of your thoughts.

Greg

Greg,

I couldn't get your code to demo the delay until I had tested it
several times. Then it started delaying every time.

Modifying the code to use a String instead of a Character object,
only took about 1/3 of the best time of the original code.
Also, there was no unexplained delay...
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware

Sub Testxyz2()
Dim char As String
Dim c As Range
Dim i As Integer
Dim ii As Long
Dim tmr As Long

Application.ScreenUpdating = False
Set c = ActiveCell
'Application.SendKeys "+{TAB}x{TAB}"
'DoEvents
tmr = Timer
For i = 1 To Len(c.Value) - 1
char = Mid$(c.Value, i, 1)
For ii = i + 1 To Len(c.Value)
If Mid$(c.Value, ii, 1) = char Then
c(2).Value = c(2).Value & char
End If
Next ii
Next i
Application.ScreenUpdating = True
MsgBox (Timer - tmr)
End Sub
'------------


"Greg Wilson"
<GregWilson@discussions.microsoft.com>
wrote in message
I have a complex macro that parses characters in the active cell and makes
changes to the worksheet. However, if the macro is run after opening the wb
before any manual cell entry is made (as opposed to clearing contents or
pasting etc.) then the macro runs very slowly. This is obvious if there is a
lot of text in the cell being parsed. However, as soon as a manual cell entry
is made to any cell in the wb the same macro takes roughly 15% as much time.
Programmatic cell entry doesn't work unless using Sendkeys.

Below is a macro that doesn't do anything meaningful except demo the
problem. Note the commented text which is a kludge that works but, suffice to
say, I would like to avoid in the real macro. It should be run with the
active cell containing some miscellaneous text of about 200 characters.
Expected run time ~12 sec. or ~2.5 sec. depending on if cell entry made. The
active cell should not be in the first column if you run the Sendkeys kludge.

Sub Testxyz()
Dim char As Characters
Dim c As Range
Dim i As Integer, ii As Long
Dim tmr As Long

Application.ScreenUpdating = False
Set c = ActiveCell
'Application.SendKeys "+{TAB}x{TAB}"
'DoEvents
tmr = Timer
For i = 1 To Len(c) - 1
Set char = c.Characters(i, 1)
For ii = i + 1 To Len(c)
If Mid(c, ii, 1) = char.Text Then
c(2) = c(2) & char.Text
End If
Next ii
Next i
Application.ScreenUpdating = True
MsgBox (Timer - tmr)
End Sub

Very appreciative of your thoughts.

Greg

Jim,

This has to do with an analyzer that colour codes individual characters
within a single text string. It is quite complex. The wb has been rebuilt
once to no effect. I need to be able to parse through the text and capture
the font colour of individual characters. A text string won't work by current
design.

(xl2000 SP-3 Windows 2000 Professional)

I reliably get the phenomenon described assuming I close the wb and after
reopening make no manual cell entries before running the macro. Then, if I
enter any text into any cell in the wb and rerun it I get a much faster
result. Are you saying you don't replicate this? Following is a formula of
Tom's (no relevance) that I copied from one of his posts. Try it on it.

'=MID(A2,SMALL(IF(ISNUMBER(MID(A2,ROW(INDIRECT("1:"&LEN(A2))),1)*1),ROW(INDIRECT("1:"&LEN(A2)))),1), FIND(".",A2)-SMALL(IF(ISNUMBER(MID(A2,ROW(INDIRECT("1:"&LEN(A2))),1)*1),ROW(INDIRECT("1:"&LEN(A2)))),1))

Thanks,
Greg


"Jim Cone" wrote:

> Greg,
>
> I couldn't get your code to demo the delay until I had tested it
> several times. Then it started delaying every time.
>
> Modifying the code to use a String instead of a Character object,
> only took about 1/3 of the best time of the original code.
> Also, there was no unexplained delay...
> --
> Jim Cone
> San Francisco, USA
> http://www.realezsites.com/bus/primitivesoftware
>
> Sub Testxyz2()
> Dim char As String
> Dim c As Range
> Dim i As Integer
> Dim ii As Long
> Dim tmr As Long
>
> Application.ScreenUpdating = False
> Set c = ActiveCell
> 'Application.SendKeys "+{TAB}x{TAB}"
> 'DoEvents
> tmr = Timer
> For i = 1 To Len(c.Value) - 1
> char = Mid$(c.Value, i, 1)
> For ii = i + 1 To Len(c.Value)
> If Mid$(c.Value, ii, 1) = char Then
> c(2).Value = c(2).Value & char
> End If
> Next ii
> Next i
> Application.ScreenUpdating = True
> MsgBox (Timer - tmr)
> End Sub
> '------------
>
>
> "Greg Wilson"
> <GregWilson@discussions.microsoft.com>
> wrote in message
> I have a complex macro that parses characters in the active cell and makes
> changes to the worksheet. However, if the macro is run after opening the wb
> before any manual cell entry is made (as opposed to clearing contents or
> pasting etc.) then the macro runs very slowly. This is obvious if there is a
> lot of text in the cell being parsed. However, as soon as a manual cell entry
> is made to any cell in the wb the same macro takes roughly 15% as much time.
> Programmatic cell entry doesn't work unless using Sendkeys.
>
> Below is a macro that doesn't do anything meaningful except demo the
> problem. Note the commented text which is a kludge that works but, suffice to
> say, I would like to avoid in the real macro. It should be run with the
> active cell containing some miscellaneous text of about 200 characters.
> Expected run time ~12 sec. or ~2.5 sec. depending on if cell entry made. The
> active cell should not be in the first column if you run the Sendkeys kludge.
>
> Sub Testxyz()
> Dim char As Characters
> Dim c As Range
> Dim i As Integer, ii As Long
> Dim tmr As Long
>
> Application.ScreenUpdating = False
> Set c = ActiveCell
> 'Application.SendKeys "+{TAB}x{TAB}"
> 'DoEvents
> tmr = Timer
> For i = 1 To Len(c) - 1
> Set char = c.Characters(i, 1)
> For ii = i + 1 To Len(c)
> If Mid(c, ii, 1) = char.Text Then
> c(2) = c(2) & char.Text
> End If
> Next ii
> Next i
> Application.ScreenUpdating = True
> MsgBox (Timer - tmr)
> End Sub
>
> Very appreciative of your thoughts.
>
> Greg
>
>

I also get the phenomenon in a brand new wb with nothing else in it but the
demo macro and Tom's formula.

Greg

"Jim Cone" wrote:

> Greg,
>
> I couldn't get your code to demo the delay until I had tested it
> several times. Then it started delaying every time.
>
> Modifying the code to use a String instead of a Character object,
> only took about 1/3 of the best time of the original code.
> Also, there was no unexplained delay...
> --
> Jim Cone
> San Francisco, USA
> http://www.realezsites.com/bus/primitivesoftware
>
> Sub Testxyz2()
> Dim char As String
> Dim c As Range
> Dim i As Integer
> Dim ii As Long
> Dim tmr As Long
>
> Application.ScreenUpdating = False
> Set c = ActiveCell
> 'Application.SendKeys "+{TAB}x{TAB}"
> 'DoEvents
> tmr = Timer
> For i = 1 To Len(c.Value) - 1
> char = Mid$(c.Value, i, 1)
> For ii = i + 1 To Len(c.Value)
> If Mid$(c.Value, ii, 1) = char Then
> c(2).Value = c(2).Value & char
> End If
> Next ii
> Next i
> Application.ScreenUpdating = True
> MsgBox (Timer - tmr)
> End Sub
> '------------
>
>
> "Greg Wilson"
> <GregWilson@discussions.microsoft.com>
> wrote in message
> I have a complex macro that parses characters in the active cell and makes
> changes to the worksheet. However, if the macro is run after opening the wb
> before any manual cell entry is made (as opposed to clearing contents or
> pasting etc.) then the macro runs very slowly. This is obvious if there is a
> lot of text in the cell being parsed. However, as soon as a manual cell entry
> is made to any cell in the wb the same macro takes roughly 15% as much time.
> Programmatic cell entry doesn't work unless using Sendkeys.
>
> Below is a macro that doesn't do anything meaningful except demo the
> problem. Note the commented text which is a kludge that works but, suffice to
> say, I would like to avoid in the real macro. It should be run with the
> active cell containing some miscellaneous text of about 200 characters.
> Expected run time ~12 sec. or ~2.5 sec. depending on if cell entry made. The
> active cell should not be in the first column if you run the Sendkeys kludge.
>
> Sub Testxyz()
> Dim char As Characters
> Dim c As Range
> Dim i As Integer, ii As Long
> Dim tmr As Long
>
> Application.ScreenUpdating = False
> Set c = ActiveCell
> 'Application.SendKeys "+{TAB}x{TAB}"
> 'DoEvents
> tmr = Timer
> For i = 1 To Len(c) - 1
> Set char = c.Characters(i, 1)
> For ii = i + 1 To Len(c)
> If Mid(c, ii, 1) = char.Text Then
> c(2) = c(2) & char.Text
> End If
> Next ii
> Next i
> Application.ScreenUpdating = True
> MsgBox (Timer - tmr)
> End Sub
>
> Very appreciative of your thoughts.
>
> Greg
>
>

Greg,
I still don't know what causes the delay, I am just trying alternatives.
I was using a 260 character string then switched to your shorter string.
There was no difference between the two, other than the shorter string
took less time.
The only thing I have to work with is your posted code and char.Text is
a string. So still using the characters object but converting Char.Text
to a string variable made it run like a race horse. I also changed the
timing method to get more accurate/consistent times.
Jim Cone

'------------
Private Declare Function timeGetTime Lib "winmm.dll" () As Long

Sub Testxyz3()
Dim strChar As String
Dim char As Characters
Dim c As Range
Dim i As Integer, ii As Long
Dim tmr As Long
Dim lngLength As Long

Application.ScreenUpdating = False
tmr = timeGetTime
Set c = ActiveCell
lngLength = Len(c.Text)

For i = 1 To lngLength - 1
Set char = c.Characters(i, 1)
strChar = char.Text
For ii = i + 1 To lngLength
If Mid$(c.Value, ii, 1) = strChar Then
c(2).Value = c(2).Value & strChar
End If
Next 'ii
Next 'i
Application.ScreenUpdating = True
MsgBox (timeGetTime - tmr) / 1000
End Sub
'------------

"Greg Wilson" <GregWilson@discussions.microsoft.com>
wrote in message
I also get the phenomenon in a brand new wb with nothing else in it but the
demo macro and Tom's formula.

Greg,

For what it's worth, you can check if the font in a cell has more that
one color applied by checking if the ColorIndex returns Null...

If IsNull(c.Font.ColorIndex) then
' more than one color

Jim Cone
http://www.officeletter.com/blink/specialsort.html

Hi Greg,

I can't put together what you describe below with the demo in your OP (what
was the doevents & sendkeys for - would slow to a crawl). In that you appear
to be parsing characters directly in the characters object, one by one,
which would be very slow. Why not read the string to a variable, do whatever
parsing and return to the cell.value. While doing that keep a record of
sections you want to format (start's & length's) then apply to
character.font (adjacent characters in one go), color, bold etc. Perhaps
first reset whatever overall default formats to cell.font.

Regards,
Peter T


at the same time keep a record
"Greg Wilson" <GregWilson@discussions.microsoft.com> wrote in message
news:D81074C2-13B0-4E71-ACA1-B367B227C6EA@microsoft.com...
> Jim,
>
> This has to do with an analyzer that colour codes individual characters
> within a single text string. It is quite complex. The wb has been rebuilt
> once to no effect. I need to be able to parse through the text and capture
> the font colour of individual characters. A text string won't work by
current
> design.
>
> (xl2000 SP-3 Windows 2000 Professional)
>
> I reliably get the phenomenon described assuming I close the wb and after
> reopening make no manual cell entries before running the macro. Then, if I
> enter any text into any cell in the wb and rerun it I get a much faster
> result. Are you saying you don't replicate this? Following is a formula of
> Tom's (no relevance) that I copied from one of his posts. Try it on it.
>
>
'=MID(A2,SMALL(IF(ISNUMBER(MID(A2,ROW(INDIRECT("1:"&LEN(A2))),1)*1),ROW(INDI
RECT("1:"&LEN(A2)))),1),FIND(".",A2)-SMALL(IF(ISNUMBER(MID(A2,ROW(INDIRECT("
1:"&LEN(A2))),1)*1),ROW(INDIRECT("1:"&LEN(A2)))),1))
>
> Thanks,
> Greg
>
>
> "Jim Cone" wrote:
>
> > Greg,
> >
> > I couldn't get your code to demo the delay until I had tested it
> > several times. Then it started delaying every time.
> >
> > Modifying the code to use a String instead of a Character object,
> > only took about 1/3 of the best time of the original code.
> > Also, there was no unexplained delay...
> > --
> > Jim Cone
> > San Francisco, USA
> > http://www.realezsites.com/bus/primitivesoftware
> >
> > Sub Testxyz2()
> > Dim char As String
> > Dim c As Range
> > Dim i As Integer
> > Dim ii As Long
> > Dim tmr As Long
> >
> > Application.ScreenUpdating = False
> > Set c = ActiveCell
> > 'Application.SendKeys "+{TAB}x{TAB}"
> > 'DoEvents
> > tmr = Timer
> > For i = 1 To Len(c.Value) - 1
> > char = Mid$(c.Value, i, 1)
> > For ii = i + 1 To Len(c.Value)
> > If Mid$(c.Value, ii, 1) = char Then
> > c(2).Value = c(2).Value & char
> > End If
> > Next ii
> > Next i
> > Application.ScreenUpdating = True
> > MsgBox (Timer - tmr)
> > End Sub
> > '------------
> >
> >
> > "Greg Wilson"
> > <GregWilson@discussions.microsoft.com>
> > wrote in message
> > I have a complex macro that parses characters in the active cell and
makes
> > changes to the worksheet. However, if the macro is run after opening the
wb
> > before any manual cell entry is made (as opposed to clearing contents or
> > pasting etc.) then the macro runs very slowly. This is obvious if there
is a
> > lot of text in the cell being parsed. However, as soon as a manual cell
entry
> > is made to any cell in the wb the same macro takes roughly 15% as much
time.
> > Programmatic cell entry doesn't work unless using Sendkeys.
> >
> > Below is a macro that doesn't do anything meaningful except demo the
> > problem. Note the commented text which is a kludge that works but,
suffice to
> > say, I would like to avoid in the real macro. It should be run with the
> > active cell containing some miscellaneous text of about 200 characters.
> > Expected run time ~12 sec. or ~2.5 sec. depending on if cell entry made.
The
> > active cell should not be in the first column if you run the Sendkeys
kludge.
> >
> > Sub Testxyz()
> > Dim char As Characters
> > Dim c As Range
> > Dim i As Integer, ii As Long
> > Dim tmr As Long
> >
> > Application.ScreenUpdating = False
> > Set c = ActiveCell
> > 'Application.SendKeys "+{TAB}x{TAB}"
> > 'DoEvents
> > tmr = Timer
> > For i = 1 To Len(c) - 1
> > Set char = c.Characters(i, 1)
> > For ii = i + 1 To Len(c)
> > If Mid(c, ii, 1) = char.Text Then
> > c(2) = c(2) & char.Text
> > End If
> > Next ii
> > Next i
> > Application.ScreenUpdating = True
> > MsgBox (Timer - tmr)
> > End Sub
> >
> > Very appreciative of your thoughts.
> >
> > Greg
> >
> >

Thanks Jim for your help.

My demo code unfortunately dealt with character text instead of character
font colour which is the actual case. In the actual situation, the character
font colour will vary for the cell contents being parsed because it is colour
coded. The demo code also has a nested loop which is not the case. It does
demo the weird phenomenon I described but this is apparently version specific
(Peter T didn't find this).

I was aware of the inefficiency issue regarding parsing Characters (objects)
vs. parsing a string. However, your post drove home the extraordinary
significance of this inefficiency. There are two aspects to the main macro:
setting character font colour and reading character font colour. I cannot
avoid the setting part but at one point in the process I have the opportunity
to store the font colour info either to an array or even concatenating to a
string. This will add a level of complexity and will be less intuitive than
checking font colour but I believe will be of great benefit (as indicated by
your example).

My main concern isn't actually performance but on infrequent occasion the
worksheet will freeze. I believe this results from parsing characters while
at the same time doing a bunch of other stuff.

Thanks again Jim and you too Peter.

Best regards,
Greg







"Jim Cone" wrote:

> Greg,
>
> For what it's worth, you can check if the font in a cell has more that
> one color applied by checking if the ColorIndex returns Null...
>
> If IsNull(c.Font.ColorIndex) then
> ' more than one color
>
> Jim Cone
> http://www.officeletter.com/blink/specialsort.html
>
>

Hi Peter,

The SendKeys and DoEvents was an admitted kludge that achieved the requisite
cell entry that enabled faster performance. For some weird reason the macro
performs much faster after a manual (or SendKeys) cell entry has been made,
at least on my system. If you close the wb and reopen and then immediately
run the macro it will perform much slower than after making a simple entry to
any cell in the wb. Pasting and deleting cell contents, nor programmatic cell
change (except SendKeys) doesn't work.

The demo macro only produced the above effect. My actual macro needs to
parse the characters checking for individual character font colour because
of colour coding. Hence passing to a string won't work. See my last post to
Jim.

Regards,
Greg



"Peter T" wrote:

> Hi Greg,
>
> I can't put together what you describe below with the demo in your OP (what
> was the doevents & sendkeys for - would slow to a crawl). In that you appear
> to be parsing characters directly in the characters object, one by one,
> which would be very slow. Why not read the string to a variable, do whatever
> parsing and return to the cell.value. While doing that keep a record of
> sections you want to format (start's & length's) then apply to
> character.font (adjacent characters in one go), color, bold etc. Perhaps
> first reset whatever overall default formats to cell.font.
>
> Regards,
> Peter T
>
>
> at the same time keep a record
> "Greg Wilson" <GregWilson@discussions.microsoft.com> wrote in message
> news:D81074C2-13B0-4E71-ACA1-B367B227C6EA@microsoft.com...
> > Jim,
> >
> > This has to do with an analyzer that colour codes individual characters
> > within a single text string. It is quite complex. The wb has been rebuilt
> > once to no effect. I need to be able to parse through the text and capture
> > the font colour of individual characters. A text string won't work by
> current
> > design.
> >
> > (xl2000 SP-3 Windows 2000 Professional)
> >
> > I reliably get the phenomenon described assuming I close the wb and after
> > reopening make no manual cell entries before running the macro. Then, if I
> > enter any text into any cell in the wb and rerun it I get a much faster
> > result. Are you saying you don't replicate this? Following is a formula of
> > Tom's (no relevance) that I copied from one of his posts. Try it on it.
> >
> >
> '=MID(A2,SMALL(IF(ISNUMBER(MID(A2,ROW(INDIRECT("1:"&LEN(A2))),1)*1),ROW(INDI
> RECT("1:"&LEN(A2)))),1),FIND(".",A2)-SMALL(IF(ISNUMBER(MID(A2,ROW(INDIRECT("
> 1:"&LEN(A2))),1)*1),ROW(INDIRECT("1:"&LEN(A2)))),1))
> >
> > Thanks,
> > Greg
> >
> >
> > "Jim Cone" wrote:
> >
> > > Greg,
> > >
> > > I couldn't get your code to demo the delay until I had tested it
> > > several times. Then it started delaying every time.
> > >
> > > Modifying the code to use a String instead of a Character object,
> > > only took about 1/3 of the best time of the original code.
> > > Also, there was no unexplained delay...
> > > --
> > > Jim Cone
> > > San Francisco, USA
> > > http://www.realezsites.com/bus/primitivesoftware
> > >
> > > Sub Testxyz2()
> > > Dim char As String
> > > Dim c As Range
> > > Dim i As Integer
> > > Dim ii As Long
> > > Dim tmr As Long
> > >
> > > Application.ScreenUpdating = False
> > > Set c = ActiveCell
> > > 'Application.SendKeys "+{TAB}x{TAB}"
> > > 'DoEvents
> > > tmr = Timer
> > > For i = 1 To Len(c.Value) - 1
> > > char = Mid$(c.Value, i, 1)
> > > For ii = i + 1 To Len(c.Value)
> > > If Mid$(c.Value, ii, 1) = char Then
> > > c(2).Value = c(2).Value & char
> > > End If
> > > Next ii
> > > Next i
> > > Application.ScreenUpdating = True
> > > MsgBox (Timer - tmr)
> > > End Sub
> > > '------------
> > >
> > >
> > > "Greg Wilson"
> > > <GregWilson@discussions.microsoft.com>
> > > wrote in message
> > > I have a complex macro that parses characters in the active cell and
> makes
> > > changes to the worksheet. However, if the macro is run after opening the
> wb
> > > before any manual cell entry is made (as opposed to clearing contents or
> > > pasting etc.) then the macro runs very slowly. This is obvious if there
> is a
> > > lot of text in the cell being parsed. However, as soon as a manual cell
> entry
> > > is made to any cell in the wb the same macro takes roughly 15% as much
> time.
> > > Programmatic cell entry doesn't work unless using Sendkeys.
> > >
> > > Below is a macro that doesn't do anything meaningful except demo the
> > > problem. Note the commented text which is a kludge that works but,
> suffice to
> > > say, I would like to avoid in the real macro. It should be run with the
> > > active cell containing some miscellaneous text of about 200 characters.
> > > Expected run time ~12 sec. or ~2.5 sec. depending on if cell entry made.
> The
> > > active cell should not be in the first column if you run the Sendkeys
> kludge.
> > >
> > > Sub Testxyz()
> > > Dim char As Characters
> > > Dim c As Range
> > > Dim i As Integer, ii As Long
> > > Dim tmr As Long
> > >
> > > Application.ScreenUpdating = False
> > > Set c = ActiveCell
> > > 'Application.SendKeys "+{TAB}x{TAB}"
> > > 'DoEvents
> > > tmr = Timer
> > > For i = 1 To Len(c) - 1
> > > Set char = c.Characters(i, 1)
> > > For ii = i + 1 To Len(c)
> > > If Mid(c, ii, 1) = char.Text Then
> > > c(2) = c(2) & char.Text
> > > End If
> > > Next ii
> > > Next i
> > > Application.ScreenUpdating = True
> > > MsgBox (Timer - tmr)
> > > End Sub
> > >
> > > Very appreciative of your thoughts.
> > >
> > > Greg
> > >
> > >
>
>
>

Peter, I forgot to mention that I'm already doing what you suggested. Snippet:
c(2).Characters(n1 + 1, n2 - n1).Font.Color = clr

I also need to parse to check character font colour but I am planning to
store the character font colour to an array (or code it by concatenating to a
string) at the same time the above snippet is run. Later search the array (or
string) as an alternative to checking character font colour - i.e. instead of:
For i = 1 To Len(txt)
Set char = cc.Characters(i, 1)
If char.Font.Color <> vbWhite Then...

Regards,
Greg

"Peter T" wrote:

> Hi Greg,
>
> I can't put together what you describe below with the demo in your OP (what
> was the doevents & sendkeys for - would slow to a crawl). In that you appear
> to be parsing characters directly in the characters object, one by one,
> which would be very slow. Why not read the string to a variable, do whatever
> parsing and return to the cell.value. While doing that keep a record of
> sections you want to format (start's & length's) then apply to
> character.font (adjacent characters in one go), color, bold etc. Perhaps
> first reset whatever overall default formats to cell.font.
>
> Regards,
> Peter T
>
>
> at the same time keep a record
> "Greg Wilson" <GregWilson@discussions.microsoft.com> wrote in message
> news:D81074C2-13B0-4E71-ACA1-B367B227C6EA@microsoft.com...
> > Jim,
> >
> > This has to do with an analyzer that colour codes individual characters
> > within a single text string. It is quite complex. The wb has been rebuilt
> > once to no effect. I need to be able to parse through the text and capture
> > the font colour of individual characters. A text string won't work by
> current
> > design.
> >
> > (xl2000 SP-3 Windows 2000 Professional)
> >
> > I reliably get the phenomenon described assuming I close the wb and after
> > reopening make no manual cell entries before running the macro. Then, if I
> > enter any text into any cell in the wb and rerun it I get a much faster
> > result. Are you saying you don't replicate this? Following is a formula of
> > Tom's (no relevance) that I copied from one of his posts. Try it on it.
> >
> >
> '=MID(A2,SMALL(IF(ISNUMBER(MID(A2,ROW(INDIRECT("1:"&LEN(A2))),1)*1),ROW(INDI
> RECT("1:"&LEN(A2)))),1),FIND(".",A2)-SMALL(IF(ISNUMBER(MID(A2,ROW(INDIRECT("
> 1:"&LEN(A2))),1)*1),ROW(INDIRECT("1:"&LEN(A2)))),1))
> >
> > Thanks,
> > Greg
> >
> >
> > "Jim Cone" wrote:
> >
> > > Greg,
> > >
> > > I couldn't get your code to demo the delay until I had tested it
> > > several times. Then it started delaying every time.
> > >
> > > Modifying the code to use a String instead of a Character object,
> > > only took about 1/3 of the best time of the original code.
> > > Also, there was no unexplained delay...
> > > --
> > > Jim Cone
> > > San Francisco, USA
> > > http://www.realezsites.com/bus/primitivesoftware
> > >
> > > Sub Testxyz2()
> > > Dim char As String
> > > Dim c As Range
> > > Dim i As Integer
> > > Dim ii As Long
> > > Dim tmr As Long
> > >
> > > Application.ScreenUpdating = False
> > > Set c = ActiveCell
> > > 'Application.SendKeys "+{TAB}x{TAB}"
> > > 'DoEvents
> > > tmr = Timer
> > > For i = 1 To Len(c.Value) - 1
> > > char = Mid$(c.Value, i, 1)
> > > For ii = i + 1 To Len(c.Value)
> > > If Mid$(c.Value, ii, 1) = char Then
> > > c(2).Value = c(2).Value & char
> > > End If
> > > Next ii
> > > Next i
> > > Application.ScreenUpdating = True
> > > MsgBox (Timer - tmr)
> > > End Sub
> > > '------------
> > >
> > >
> > > "Greg Wilson"
> > > <GregWilson@discussions.microsoft.com>
> > > wrote in message
> > > I have a complex macro that parses characters in the active cell and
> makes
> > > changes to the worksheet. However, if the macro is run after opening the
> wb
> > > before any manual cell entry is made (as opposed to clearing contents or
> > > pasting etc.) then the macro runs very slowly. This is obvious if there
> is a
> > > lot of text in the cell being parsed. However, as soon as a manual cell
> entry
> > > is made to any cell in the wb the same macro takes roughly 15% as much
> time.
> > > Programmatic cell entry doesn't work unless using Sendkeys.
> > >
> > > Below is a macro that doesn't do anything meaningful except demo the
> > > problem. Note the commented text which is a kludge that works but,
> suffice to
> > > say, I would like to avoid in the real macro. It should be run with the
> > > active cell containing some miscellaneous text of about 200 characters.
> > > Expected run time ~12 sec. or ~2.5 sec. depending on if cell entry made.
> The
> > > active cell should not be in the first column if you run the Sendkeys
> kludge.
> > >
> > > Sub Testxyz()
> > > Dim char As Characters
> > > Dim c As Range
> > > Dim i As Integer, ii As Long
> > > Dim tmr As Long
> > >
> > > Application.ScreenUpdating = False
> > > Set c = ActiveCell
> > > 'Application.SendKeys "+{TAB}x{TAB}"
> > > 'DoEvents
> > > tmr = Timer
> > > For i = 1 To Len(c) - 1
> > > Set char = c.Characters(i, 1)
> > > For ii = i + 1 To Len(c)
> > > If Mid(c, ii, 1) = char.Text Then
> > > c(2) = c(2) & char.Text
> > > End If
> > > Next ii
> > > Next i
> > > Application.ScreenUpdating = True
> > > MsgBox (Timer - tmr)
> > > End Sub
> > >
> > > Very appreciative of your thoughts.
> > >
> > > Greg
> > >
> > >
>
>
>

Jim,

Final note: I have successfully implemented the fix I mentioned coding to a
text string and parsing the string instead of parsing characters. I'm still
setting the font colour as before but not reading it. The worst case scenario
formerly took 25 seconds to process after first opening the wb. It now takes
a tad under 1 second !!! For most cases, the macro is now so fast that it
looks like the text is always there and I'm only toggling the visible status.
I am willing to bet that the worksheet freezing issue is history also. So
parsing characters and READING properties is a very bad idea. All take note:
Avoid this at all costs.

Your post gave me the gumption to do this. Thanks a million !!!!

Greg



"Jim Cone" wrote:

> Greg,
>
> For what it's worth, you can check if the font in a cell has more that
> one color applied by checking if the ColorIndex returns Null...
>
> If IsNull(c.Font.ColorIndex) then
> ' more than one color
>
> Jim Cone
> http://www.officeletter.com/blink/specialsort.html
>
>