Re: Separating Strings of Text

Tech-Archive recommends: Fix windows errors by optimizing your registry

Ben,

I've set up a function for finding those models where the text font is
'red'. I think you will be able to modify this to create a set of
functions, one for each of your colors. You should take the time to
determine the numerical code for each of the colors. I believe that red is
255, blue is 16711680, green is 32768, orange is 26367, yellow is 65535,
purple is 8388736, grey is 8421504. Your perception of shade and color may
be different from mine so you should confirm these. For example, for grey,
I chose the 50% grey shade and you might be using something else.

Here is a very short function you can use to get the codes. Just install
the function, enter text in cells using different font colors and then run
the function on those cells.

'--------------------------------------

Function ColorIndex(myRange As Range) As Variant
ColorIndex = myRange.Font.Color
End Function

'-------------------------------------

Below, I have the actual function for counting the number of items in red
font. Note that the routine looks at each character within the model name
and if a single character has a red font, the block of text will be counted
as a red (it won't matter what color the commas are).

In addition to creating new function names for the other colors, you will
need to edit two lines within the block of code. For example, when you
create 'CountYellowItems' you will edit the top line
Const desigColor = 255
to be
Const desigColor 65535
and the last line that reads
CountRedItems = intColorCount
would be changed to
CountYellowItems = intColorCount

'-----------------------------------------------------------

Function CountRedItems(myRange As Range) As Integer

Const desigColor = 255 ' This is the value for the color red

Dim rngCell As Range
Dim intColorCount As Integer
Dim intCharCount As Integer
Dim modelArray() As String
Dim tmpColor As Variant
Dim intTempLen As Integer
Dim isSelColor As Boolean

intColorCount = 0
intCharCount = 0
isSelColor = False

For Each rngCell In myRange
If Len(rngCell.Text > 0) Then
modelArray = Split(rngCell.Text, ",")
For m = 0 To UBound(modelArray)
intTempLen = Len(modelArray(m))
For l = intCharCount + 2 To intCharCount + intTempLen
tmpColor = rngCell.Characters(l, 1).Font.Color
If tmpColor = desigColor Then
isSelColor = True
End If
Next l
If isSelColor = True Then
intColorCount = intColorCount + 1
isSelColor = False
End If
intCharCount = intCharCount + intTempLen + 1
Next m
End If
intCharCount = 0
isSelColor = False
Next rngCell

CountRedItems = intColorCount

End Function

'----------------------------------------------------------

Steve Yandl



"Ben in CA" <BeninCA@xxxxxxxxxxxxxxxxxxxxxxxxx> wrote in message
news:7C42D7E3-C60F-47C7-8746-C9C9D3EAAA9F@xxxxxxxxxxxxxxxx
Thanks a lot Steve!

Ben

"Steve Yandl" wrote:

Ben,

It would be a bit more complex to count instances of different colors but
can be done. I'll see if I can find a little time to work on it in the
next
couple of days.

Steve


"Ben in CA" <BeninCA@xxxxxxxxxxxxxxxxxxxxxxxxx> wrote in message
news:A367D8CE-C890-4E2F-B380-EAF1516382AC@xxxxxxxxxxxxxxxx
Hi Steve,

That's phenomenal! The first part is exactly what I wanted.

As for the color counting - how could this be setup so that it lists
how
many green, how many blue, how many red, etc.

So that I could put
=CountColorRed'Items'!(F4:M137)
=CountColorBlue'Items'!(F4:M137)
=CountColorGreen'Items'!(F4:M137)
=CountColorOrange'Items'!(F4:M137)
=CountColorYellow'Items'!(F4:M137)
=CountColorPurple'Items'!(F4:M137)
=CountColorGrey'Items'!(F4:M137)

Is there a way that these can be combined?

Thank you for your time!

Ben

"Steve Yandl" wrote:

Ben,

You could place the following two functions in a module (same place
you
would typically store a macro. Then, you could use the functions in
your
workbook the same as you use Excel's fundtions. For example, if you
wanted
a count of all the strings separated by commas found in A1:D50 and a
count
of all the unique font colors appearing in the same range,
=ModelCount(a1:d50)
would give the number of strings and
=ColorCount(a1:d50)
would give the count of how many different colors were used in the
same
range.

'---------------------------------------------------

Function ModelCount(myRange As Range) As Integer
Dim rngCell As Range
Dim intCount As Integer

intCount = 0
For Each rngCell In myRange
If Len(rngCell.Text > 0) Then
intCount = intCount + UBound(Split(rngCell.Text, ",")) + 1
End If
Next rngCell

ModelCount = intCount

End Function



Function ColorCount(theRange As Range) As Long
Dim rgnCell As Range
Dim txtColor As Variant

Set clrDict = CreateObject("Scripting.Dictionary")

For Each rngCell In theRange
If Len(rngCell.Text > 0) Then
For x = 1 To Len(rngCell.Text)
txtColor = rngCell.Characters(x, x).Font.Color
If Len(txtColor) > 0 Then
If Not clrDict.Exists(txtColor) Then
clrDict.Add txtColor, txtColor
End If
End If
Next x
End If
Next rngCell

ColorCount = clrDict.Count

Set clrDict = Nothing

End Function


'--------------------------------------------------

Steve Yandl



"Ben in CA" <BeninCA@xxxxxxxxxxxxxxxxxxxxxxxxx> wrote in message
news:50B5ACC5-16F7-462D-AD2E-3F818943C7A1@xxxxxxxxxxxxxxxx
I haven't got this figured out yet.

I'd be open to using a complex macro if required - if anyone has any
ideas.

Thanks,

Ben

"Ben in CA" wrote:

Hi,

A user has presented a challenge that I'm wondering if it's
possible.

The spread*** has columns of cells each containing several model
numbers,
and the values are separated by commas and spaces in each cell.
(eg.
8890,
x3340, mx750)

To make things more confusing, each model is colored differently
depending
on the distributor, and there are several different colors in some
cells.
In
total, about six different colors are used (green, red, blue
orange,
gray,
purple).

Is there a way I can create a "SUM count" based on how many
individual
strings are in a range of cells?

How about how many strings exist of each color for a range?

Am I asking the impossible?

I know there's some options for sorting by color, etc. in Excel
2007,
I
don't know if that helps, though.
(http://msdn.microsoft.com/en-us/library/cc952296.aspx)

I have Excel 2007 and older versions if that helps

Thanks to everyone who tries to figure this out.

Ben








.

Quantcast