Conditional formatting ♣ ♦ ♥ ♠NT

[keiji kounoike]

Hi Rick

Thank you for your nice comments. I know no need of EnableEvents in this
case, but i put it for the future's change though it would not happen. I
like your style of moving i=i+1 out of if block and it has made my code
very simple. Changing the color at first place contributes to the
speeding up the time of process in my test. Anyway, thanks again.

Keiji

 

[Pierre62]

Hello guys,

I encountered two minor problems.

1> When I trie to undo something (Ctrl+z), that does not work.
2> When using the macro, all text turns to black, also the one I gave
another color.

Is it hard to change this?

Kind regards,
Pierre

 

[Rick Rothstein]

1> When I trie to undo something (Ctrl+z), that does not work.

This is a problem with all VB code... it tends to clear out the clipboard.

2> When using the macro, all text turns to black, also the one
I gave another color.

This will fix my macro so it won't do that...

Sub ColorSuitSymbols()
Dim X As Long
Dim R As Range
Dim W As Worksheet
On Error Resume Next
For Each W In Worksheets
For Each R In W.UsedRange
For X = 1 To Len(R.Value)
Select Case AscW(Mid(R.Value, X, 1))
Case 9824
R.Characters(X, 1).Font.ColorIndex = 5
Case 9827
R.Characters(X, 1).Font.ColorIndex = 10
Case 9829
R.Characters(X, 1).Font.ColorIndex = 3
Case 9830
R.Characters(X, 1).Font.ColorIndex = 46
End Select
If X > 1 Then
If Mid(R.Value, X - 1, 2) = "NT" Then
R.Characters(X - 1, 2).Font.ColorIndex = 44
End If
End If
Next
Next
Next
End Sub

 

[Pierre62]

Hello Rick,

you're great.
Thanks for your efforts.

Kind regards.
Pierre

 

[Pierre62]

Hello Rick,

one more question....

I use your latest macro from 23-03-2009.
Changing this macro to what it is now, does it mean you might want to change
something in the other one, the non-macro?

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim X As Long
Dim R As Range
For Each R In Target
R.Characters.Font.ColorIndex = xlColorIndexAutomatic
For X = 1 To Len(R.Value)
Select Case AscW(Mid(R.Value, X, 1))
Case 9824 'Spade symbol
R.Characters(X, 1).Font.ColorIndex = 23
Case 9827 'Club symbol
R.Characters(X, 1).Font.ColorIndex = 10
Case 9829 'Heart symbol
R.Characters(X, 1).Font.ColorIndex = 3
Case 9830 'Diamond symbol
R.Characters(X, 1).Font.ColorIndex = 45
End Select
If X > 1 Then 'SA text
If Mid(R.Value, X - 1, 2) = "SA" Then
R.Characters(X - 1, 2).Font.ColorIndex = 7
End If
End If
Next
Next
End Sub

As you can see I changed the colors and NT is SA.


Kind regards,
Pierre

 

[Rick Rothstein]

I use your latest macro from 23-03-2009.

Changing this macro to what it is now, does it mean you might want to
change
something in the other one, the non-macro?

I don't think so. The macro visited each cell in each worksheet and (at
first) changed all text to black (actually, Automatic) before applying the
colors to those characters needing the change. The event code (what you are
calling "the non-macro") only applies the color to the symbols in the actual
cell being edited. Now, I might have to change the code for you IF you ever
have a mixture of existing, pre-colored non-symbol text together with your
symbols and you choose to edit only part of that text. The reason I would
have to change the code in that circumstance is because the event code
changes all the existing text in the cell to black (Automatic) before
applying the symbol coloring... so if you had existing colored non-symbol
text in the cell, it would be made black (Automatic) and only the symbols
would be colored. Do you, or would you ever, have such a situation?

 

[Pierre62]

Hello Rick,

I understand what you mean but I don't think I need it.

But I have another problem.
When i.e. inserting a new row, it takes a lot of time before it happens.
It seems the macro is working the whole sheet updating the symbols, or
something else.
Is it possible to limit the size of a worksheet to let's say 100 columns and
500 rows?


I am starting to feel guilty asking things everytime....

Kind regards from Pierre

 

[keiji kounoike]

Inserting a new row invokes SheetChange event, so it takes some time to
loop all cells in Target range. But it's strange for me this would take
so long time as you said. Besides in my thought, It seems the line "For
Each R In Target" is useless in your case and the code
"Application.EnableEvents = False" will stop to go into this series of
SheetChange event.

Keiji

 

[keiji kounoike]

Ignore my comment about "Application.EnableEvents = False". In this case
this doesn't have nothing with slowness. Sorry about misinformation.

keiji

 

[Pierre62]

Hello all,

I found out that a workbook with only 2 smaal sheets in it has a size of
over 11 MB.
I selected alla sheets and then all cells and changed the color of the font.
Then I saved it again.
Now the file is only 29 Kb and all is running normal.

I suppose some macro at a certain moment formatted aal cells in all sheets
with some information....

If you want the sheet for research, let me know, I will send it to you by
email.

Kind regards,
Pierre

 

[Pierre62]

Hello Rick,

I still have problems with the code you gave me.
Not the macro but the other one.
I made a new workbook with one worksheet.
I have put the non-macro in the ThisWorkbook sheet.
I deleted several comluns at one time and then Excel is working over and over.
When I hit the Esc key I select the "debug/error" button (I work with a duch
version) this line is colored yellow:

For X = 1 To Len(R.Value)

so I suppose there is the reason why it takes so long.
I hope you have the same and will be able to fix it.
If you don't have it, do you have any idea what the problem could be?

Pierre

This is the code I use:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim X As Long
Dim R As Range
For Each R In Target
R.Characters.Font.ColorIndex = xlColorIndexAutomatic
For X = 1 To Len(R.Value)
Select Case AscW(Mid(R.Value, X, 1))
Case 9824 'Spade symbol
R.Characters(X, 1).Font.ColorIndex = 23
Case 9827 'Club symbol
R.Characters(X, 1).Font.ColorIndex = 10
Case 9829 'Heart symbol
R.Characters(X, 1).Font.ColorIndex = 3
Case 9830 'Diamond symbol
R.Characters(X, 1).Font.ColorIndex = 45
End Select
If X > 1 Then 'SA text
If Mid(R.Value, X - 1, 2) = "SA" Then
R.Characters(X - 1, 2).Font.ColorIndex = 7
End If
End If
Next
Next
End Sub

 

[Bernie Deitrick]

Pierre,

You could check for the number of cells first:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim X As Long
Dim R As Range

If Target.Cells.Count > 1 Then Exit Sub

If you never use Ctrl-Enter to change multiple cells at once, then leaving
the comparison at 1 is OK.

HTH,
Bernie
MS Excel MVP

 

[Rick Rothstein]

See if this event procedure code works better for you...

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim X As Long
Dim R As Range
On Error Resume Next
For Each R In Target
For X = 1 To Len(R.Value)
Select Case AscW(Mid(R.Value, X, 1))
Case 9824 'Spade symbol
R.Characters(X, 1).Font.ColorIndex = 5
Case 9827 'Club symbol
R.Characters(X, 1).Font.ColorIndex = 10
Case 9829 'Heart symbol
R.Characters(X, 1).Font.ColorIndex = 3
Case 9830 'Diamond symbol
R.Characters(X, 1).Font.ColorIndex = 46
Case Else 'No Trump symbol
R.Characters(X, 1).Font.ColorIndex = xlColorIndexAutomatic
End Select
If X > 1 Then
If Mid(R.Value, X - 1, 2) = "NT" Then
R.Characters(X - 1, 2).Font.ColorIndex = 44
End If
End If
Next
Next
End Sub

 

[keiji kounoike]

Okay, here is a method to automatically color your symbols when you make
the entry into a cell. To implement this solution, right-click the XL
symbol immediately to the left of the File menu item and copy/paste the
following code into the code window that appears...

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim X As Long
Dim R As Range
For Each R In Target
For X = 1 To Len(R.Value)
Select Case AscW(Mid(R.Value, X, 1))
Case 9824 'Spade symbol
R.Characters(X, 1).Font.ColorIndex = 5
Case 9827 'Club symbol
R.Characters(X, 1).Font.ColorIndex = 10
Case 9829 'Heart symbol
R.Characters(X, 1).Font.ColorIndex = 3
Case 9830 'Diamond symbol
R.Characters(X, 1).Font.ColorIndex = 46
Case Else 'No Trump symbol
R.Characters(X, 1).Font.ColorIndex = xlColorIndexAutomatic
End Select
If X > 1 Then
If Mid(R.Value, X - 1, 2) = "NT" Then
R.Characters(X - 1, 2).Font.ColorIndex = 44
End If
End If
Next
Next
End Sub

Now, go back any worksheet and type some text that contains your card
symbols and/or No Trump symbol (note... you can have more than one
symbol within your text string if you want or need to)... when you hit
the Enter Key, those symbols will change color. Oh, and you can change
the ColorIndex assignments from those that I used if you want to... I
added some remark comments in the various Case statements so you will
know which symbol you are dealing with.

 

[Rick Rothstein]

You didn't include a message with your posting.

 

[Pierre62]

Hello Bernie,

this works good for me.
A big plus is that the undo (Ctrl+Z) function works again when I select more
than one cell.

Thanks a lot.

Kind regards from Pierre

 

[Pierre62]

Hello Rick,

that did not help me.
I did what Bernie suggested and that works.

Thanks for all your efforts.

Kind regards,
Pierre

 

[Pierre]

Ok, I'll do that

Ignore my comment about "Application.EnableEvents = False". In this case
this doesn't have nothing with slowness. Sorry about misinformation.

keiji

 

[keiji kounoike]

Sorry, I pushed Send button to the wrong article by mistake.
But I can't see any diffrence between your code posted at Sat, 21 Mar
2009 14:52:43 with Message-ID:<[email protected]>
and posted at Wed, 25 Mar 2009 16:36:19 with
Message-ID:<[email protected]> except that the later
one has "On Error Resume Next" code in it. And i just can't get it what
this code do for.

Keiji