VBA to color code within a cell (4 color deck poker)

crzytimes

New Member
Joined
Oct 28, 2016
Messages
22
Office Version
  1. 365
Platform
  1. Windows
Hi :) I'm working on a trainer to study OOP 3bet pot cbet frequencies. The trainer is going well, but I'm stuck on formatting issue. I want the flop to be colored within the cell per the suit such as in the example below.

Spades = black
Hearts = red
Diamonds = Blue

flop.png


How would I do this in VBA? Only needs to be 1 cell and not a whole column, but that cell gets refreshed every time I randomize the node...so I would stick the VBA formatting code at the end of my randomizer code.

sample.JPG
 
Last edited:

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).
Below code fire any change in sheet1, cell C2, then color it
Put in worksheet_change even:

VBA Code:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i&, flop As String
If Intersect(Target, Range("C2")) Is Nothing Then Exit Sub
Range("C2").Font.Color = vbBlack ' default color
    For i = 1 To 3
        flop = Mid(" " & Range("C2"), i * 3 - 2, 3) ' group of 3 letters
        With Range("C2").Characters(i * 3 - 2, 3).Font
            If flop Like "*h" Then ' if "h" partial matchs
                .Color = vbRed
            ElseIf flop Like "*d" Then ' if "d" partial matchs
                .Color = vbBlue
            End If
        End With
    Next
End Sub

Capture.JPG
 
Upvote 0
Solution
Below code fire any change in sheet1, cell C2, then color it
Put in worksheet_change even:

VBA Code:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i&, flop As String
If Intersect(Target, Range("C2")) Is Nothing Then Exit Sub
Range("C2").Font.Color = vbBlack ' default color
    For i = 1 To 3
        flop = Mid(" " & Range("C2"), i * 3 - 2, 3) ' group of 3 letters
        With Range("C2").Characters(i * 3 - 2, 3).Font
            If flop Like "*h" Then ' if "h" partial matchs
                .Color = vbRed
            ElseIf flop Like "*d" Then ' if "d" partial matchs
                .Color = vbBlue
            End If
        End With
    Next
End Sub

View attachment 59506


This is fantastic, by the way. One more question....how can I make it loop down a column? I'm doing something wrong...

VBA Code:
Sub Color_Flop_agg()


Dim i&, flop As String
Dim x As Integer

Application.ScreenUpdating = False

Sheets("AggregatedReport").Range("C2", Range("C2").End(xlDown)).Font.Color = vbBlack ' default color
Sheets("AggregatedReport").Range("C2", Range("C2").End(xlDown)).Font.Bold = True ' bold

' Set numrows = number of rows of data.
      NumRows = Sheets("AggregatedReport").Range("C2", Range("C2").End(xlDown)).Rows.Count
' Select cell c2.
      Range("C2").Select
' Establish "For" loop to loop "numrows" number of times.
    For x = 1 To NumRows
     For i = 1 To 3
            flop = Mid(" " & Range("C2"), i * 3 - 2, 3) ' group of 3 letters
            With Range("C2").Characters(i * 3 - 2, 3).Font
                If flop Like "*h" Then ' if "h" partial matchs
                    .Color = vbRed
                ElseIf flop Like "*d" Then ' if "d" partial matchs
                    .Color = vbBlue
             End If
            End With
        ActiveCell.Offset(1, 0).Select
    Next

' Selects cell down 1 row from active cell.
         ActiveCell.Offset(1, 0).Select
    Next
    
End Sub
 
Upvote 0
How about:
VBA Code:
Option Explicit
Sub Color_Flop_agg()
Application.ScreenUpdating = False
Dim i&, Numrows&, cell As Range, flop As String
Dim ws1 As Worksheet
Set ws1 = Worksheets("AggregatedReport")
Numrows = ws1.Cells(Rows.Count, "C").End(xlUp).Row
    With ws1.Range("C2:C" & Numrows).Font
        .Color = vbBlack ' default color
        .Bold = True 'bold
    End With
    For Each cell In ws1.Range("C2:C" & Numrows) ' loop thru each cell in column C
        For i = 1 To 3
            flop = Mid(" " & cell, i * 3 - 2, 3) ' group of 3 letters
            With cell.Characters(i * 3 - 2, 3).Font
                If flop Like "*h" Then ' if "h" partial matchs
                    .Color = vbRed
                ElseIf flop Like "*d" Then ' if "d" partial matchs
                    .Color = vbBlue
                End If
            End With
        Next
    Next
Application.ScreenUpdating = True
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,543
Messages
6,114,243
Members
448,555
Latest member
RobertJones1986

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top