Coding for counting bold / strikethrough / underline / formatted cells ?

[rjn008]

Good Morning.

I have the attached and wish to possibly count all or some of the cells that are formatted either by being bold, strikethrough, underlined, italic or coloured text / cell?

Is this possible using similar data to below;

Book2
	B	C
6	Alex Tattersley1	Man Utd
7	Alex Tattersley2	Arsenal
8	Ants Farrell (AT)	Man Utd
9	Ben Cummings	Brighton & HA
10	Brandon Wilkinson	Arsenal
11	Chris Knutton (AT)	Man Utd
12	Craig Robbo (G)	Brighton & HA
13	Daniel Cummings	Arsenal
14	Danny Colbeck	Arsenal
15	Dave Crabtree	Newcastle Utd
16	Daz Hodgson	Man City
17	Dean Barrett1	Arsenal
18	Dean Barrett2	Brighton & HA
19	Elliott Kenyon	Brighton & HA
20	Gary Crabtree	Brighton & HA
21	Gavin West	Newcastle Utd
22	Geordie Watson	Man City
23	George Wilkinson (LW)	Man Utd
24	Glen Broadbent	Arsenal
25	Harvey Oakes	Man Utd
26	Jacob Colclough	Man Utd
27	James Pinder	Arsenal
28	Jamie Ballester	Arsenal
29	Joe McAdam	Tottenham
30	Joe Slingsby (AT)	Brighton & HA
Sheet1

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
B2:C30	Expression	=ROW(B2)=CurrentRow	text	NO

Cells with Data Validation
Cell	Allow	Criteria
C28:C30	List	=$E$76:$E$96
C26	List	=$E$76:$E$96
C22:C24	List	=$E$76:$E$96
C6:C8	List	=$E$76:$E$96
C11:C12	List	=$E$76:$E$96
C17:C20	List	=$E$76:$E$96
C14:C15	List	=$E$76:$E$96

 

[MARK858]

Hi @MARK858 I have got a button now and it is working as I like, could you advise the logic to be added if I was to format 'Italic' and 'Underline'?

If it is a single underline then try...

Sub countBoldStrk()
    Dim myCell As Range
    Dim myBold As Long, myStrk As Long
    Dim myItal As Long, myUnder As Long
    
    myBold = 0
    myStrk = 0
    myItal = 0
    myUnder = 0
    
    For Each myCell In Range("D5:D29")
        If myCell.Font.Bold Then myBold = myBold + 1
        If myCell.Font.Strikethrough Then myStrk = myStrk + 1
        If myCell.Font.Italic Then myItal = myItal + 1
        If myCell.Font.Underline = xlUnderlineStyleSingle Then myUnder = myUnder + 1
    Next

    Range("D31") = myBold
    Range("D32") = myStrk
    Range("D33") = myItal
    Range("D34") = myUnder

End Sub

 

[Jeffrey Mahoney]

@Jeffrey Mahoney I have managed to work this out now how to run on both the coding above... but when i run the original one you sent it opens VBA nd highlights 'End Sub' as below, do you know why?

No, I don't know why. It works on my end. I even copied the code and ran it again

 

[MARK858]

No, I don't know why. It works on my end. I even copied the code and ran it again

Looks like the OP has a breakpoint in the code

 

[rjn008]

If it is a single underline then try...

Sub countBoldStrk()
    Dim myCell As Range
    Dim myBold As Long, myStrk As Long
    Dim myItal As Long, myUnder As Long
   
    myBold = 0
    myStrk = 0
    myItal = 0
    myUnder = 0
   
    For Each myCell In Range("D5:D29")
        If myCell.Font.Bold Then myBold = myBold + 1
        If myCell.Font.Strikethrough Then myStrk = myStrk + 1
        If myCell.Font.Italic Then myItal = myItal + 1
        If myCell.Font.Underline = xlUnderlineStyleSingle Then myUnder = myUnder + 1
    Next

    Range("D31") = myBold
    Range("D32") = myStrk
    Range("D33") = myItal
    Range("D34") = myUnder

End Sub

Thank You @MARK858 - one last one, is it possible to set it so the cell could be 'bold and italic' but to not count them individually but as a dual format? in the same coding?

 

[MARK858]

Try (untested)

Sub countBoldStrk()
    Dim myCell As Range
    Dim myBold As Long, myStrk As Long
    Dim myItal As Long, myUnder As Long, Mxd As Long
    
    myBold = 0
    myStrk = 0
    myItal = 0
    myUnder = 0
    Mxd = 0
    
    For Each myCell In Range("D5:D29")
        If myCell.Font.Bold And myCell.Font.Italic Then Mxd = Mxd + 1
        If myCell.Font.Bold Then myBold = myBold + 1
        If myCell.Font.Strikethrough Then myStrk = myStrk + 1
        If myCell.Font.Italic Then myItal = myItal + 1
        If myCell.Font.Underline <> -4142 Then myUnder = myUnder + 1
    Next

    Range("D31") = myBold - Mxd
    Range("D32") = myStrk
    Range("D33") = myItal - Mxd
    Range("D34") = myUnder
    Range("D35") = Mxd
End Sub

 

[rjn008]

Try (untested)

Sub countBoldStrk()
    Dim myCell As Range
    Dim myBold As Long, myStrk As Long
    Dim myItal As Long, myUnder As Long, Mxd As Long
   
    myBold = 0
    myStrk = 0
    myItal = 0
    myUnder = 0
    Mxd = 0
   
    For Each myCell In Range("D5:D29")
        If myCell.Font.Bold And myCell.Font.Italic Then Mxd = Mxd + 1
        If myCell.Font.Bold Then myBold = myBold + 1
        If myCell.Font.Strikethrough Then myStrk = myStrk + 1
        If myCell.Font.Italic Then myItal = myItal + 1
        If myCell.Font.Underline <> -4142 Then myUnder = myUnder + 1
    Next

    Range("D31") = myBold - Mxd
    Range("D32") = myStrk
    Range("D33") = myItal - Mxd
    Range("D34") = myUnder
    Range("D35") = Mxd
End Sub

Good Morning @MARK858 - I am going to test this today, 1 I have completely forgotten is, the count of a basic standard cell with standard font - unformatted, is that possible? rather than doing a sum, as my overall totals can be different in different columns?

 

[MARK858]

a basic standard cell with standard font - unformatted

There is no such thing as standard font and all fonts are formatted.
If you want to test a cell to see if it doesn't have strikethrough, underline etc. then AFAIK you would need to test each condition individually (basically the reverse of what I done in the previous code).