Count how many Red Words are Within a Cell function

Question

Hi! I am trying to create a function that counts how many red words are within a cell? I have cells with red and black text in it... There are some cells with only black words in it, so I would want that to come out as zero. Cells with two red words to come out as 2, cells with 3 red words to come out as 3... and so on. I was thinking of just creating a function and using it in one cell and then dragging it down to automatically apply the formula to other cells. I see a lot of similar formulas for this, but it is all to count "Cells" with colored text, and I do not want that since I am not counting cells - just counting how many "colored (red) words"... Thank you in advance for any advice or help.

Answer 1

Hi @Victoria A ,

I suggest you check if this article is helpful:
https://www.extendoffice.com/documents/excel/1418-excel-count-sum-by-font-color.html

Note: Microsoft is providing this information as a convenience to you. The sites are not controlled by Microsoft. Microsoft cannot make any representations regarding the quality, safety, or suitability of any software or information found there. Please make sure that you completely understand the risk before retrieving any suggestions from the above link.

---

If the response is helpful, please click "Accept Answer" and upvote it.
Note: Please follow the steps in our documentation to enable e-mail notifications if you want to receive the related email notification for this thread.

Answer 2

Are you attempting to get a result like the following screen shot? If so, try the User Defined Function code below.

I am unfamiliar with the method of uploading a screen shot. Not doing what I expected so if you can't see it then please get back to me.

Function CountRed(rng As Range)  
    Dim i As Long  
    Dim arrRed()  
    Dim k As Long  
    Dim strRed As String  
    Dim bolRedFound As Boolean  
      
    Application.Volatile       'Optional. Could cause some slowing of the computer  
      
    k = 1  
    ReDim arrRed(1 To k)   'Initialize to one element or ReDim Preserve can error  
    With rng  
        For i = 1 To Len(.Value)  
            If .Characters(i, 1).Font.Color = vbRed And .Characters(i, 1).Text <> Chr(32) And i <> Len(.Value) Then  
                bolRedFound = True  
                strRed = strRed & .Characters(i, 1).Text  
            End If  
            If .Characters(i, 1).Text = Chr(32) And Len(strRed) > 0 Then  
                ReDim Preserve arrRed(1 To k)  
                arrRed(k) = strRed  
                strRed = ""  
                k = k + 1  
            End If  
        Next i  
    End With  
    If bolRedFound = True Then  
        CountRed = UBound(arrRed)  
    Else  
        CountRed = 0  
    End If  
End Function  
  

Answer 3

@Victoria A

There was an error of logic in the code in my previous post. Please use the following code example instead. Unfortunately I have not worked out how to edit my previous post.

 Function CountRed(rng As Range)  
    Dim i As Long  
    Dim arrRed()  
    Dim k As Long  
    Dim strRed As String  
    Dim bolRedFound As Boolean  
         
    Application.Volatile       'Optional. Could cause some slowing of the computer  
    k = 1  
    ReDim arrRed(1 To k)   'Initialize to one element or ReDim Preserve can error  
    With rng  
        For i = 1 To Len(.Value)  
            If .Characters(i, 1).Font.Color = vbRed And (.Characters(i, 1).Text <> Chr(32) Or i = Len(.Value)) Then  
                bolRedFound = True  
                strRed = strRed & .Characters(i, 1).Text  
            End If  
            If (.Characters(i, 1).Text = Chr(32) Or i = Len(.Value)) And Len(strRed) > 0 Then  
                ReDim Preserve arrRed(1 To k)  
                arrRed(k) = strRed  
                strRed = ""  
                k = k + 1  
            End If  
        Next i  
    End With  
    If bolRedFound = True Then  
        CountRed = UBound(arrRed)  
    Else  
        CountRed = 0  
    End If  
 End Function  

Answer 4

Did you spell the name of the function correctly? In your post here it is not correct.

Answer 5

@Victoria A ,

If you can't get it to work then please upload an example file to OneDrive and I will have a look at it for you. If your working file contains sensitive data then create a file with dummy data.

Guidelines to upload a workbook on OneDrive. (If you already use OneDrive and your process for saving to it is different then you can probably start at step 8 to get the link but please zip the file before uploading.)
Sharing links to business OneDrive often does not work because the business has applied security measures that prevent this. Some people take a copy of the workbook home and upload from their private OneDrive.

1. Zip your workbooks. Do not just save an unzipped workbook to OneDrive because the workbooks open with On-Line Excel and the limited functionality with the On-Line version causes problems.
2. To Zip a file: In Windows Explorer Right click on the selected file and select Send to -> Compressed (zipped) folder). By holding the Ctrl key and left click once on each file, you can select multiple workbooks before right clicking over one of the selections to send to a compressed file and they will all be included into the one Zip file.
3. Do not use 3rd party compression applications because I cannot unzip them. I do not clog up my computer with 3rd party apps when there are perfectly good apps supplied with windows.
4. Go to this link. https://onedrive.live.com
5. Use the same login Id and Password that you use for this forum.
6. Select Upload under the blue bar across the top and browse to the zipped folder to be uploaded.
7. Select Open (or just double click). (Be patient and give it time to display the file after initially seeing the popup indicating it is done.)
8. Right click the file name in OneDrive.
9. Select Share.
10. Click the link icon (Looks like chain links) at the bottom left of the dialog (Just above "Copy link").
11. Click Copy button.
12. Change back to this forum and click the "Insert Hyperlink" icon at top of the posting editor (Icon looks like chain links).
13. Right click in the Web address field and right click and paste (or just Ctrl V to paste).
14. Click "Insert" Button.