×
INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Contact US

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

EXCEL VBA QUESTION - PRETTY SIMPLE I SUSPECT

EXCEL VBA QUESTION - PRETTY SIMPLE I SUSPECT

EXCEL VBA QUESTION - PRETTY SIMPLE I SUSPECT

(OP)

I have the following function whcih I want to use to check the number of cells with a font of a particular colour (ie colour index43).

I have a question: How do I make the cell I select at ***1 the active cell.

Does anyone know of an easier way to count the number of cells in a column or row with a specific text colour?

Many Thanks
Ross



Function VerticalCount(Column As String, RowStart As Integer, RowEnd As Integer)

Dim a As String
Dim i As Integer
Dim ColourTextCount As Integer
Dim Col_Red As Double
Dim Col_blue As Double
Dim Col_green As Double

'Initialise Count of Specific Coloured Cells
ColouredCellsCount = 0

CurrentRow = RowStart
    
    Range(Column & RowStart).Select '*******************************************1*
        
     Do While Excel.ActiveCell.Row <= RowEnd
        If Excel.ActiveCell.Font.ColorIndex = 43 Then
            ColourTextCount = ColourTextCount + 1
        Else
        End If
        CurrentRow = CurrentRow + 1
        Range(Column & CurrentRow).Select '***************************************1*
    Loop
        
VerticalCount = ColourTextCount
        
End Function

RE: EXCEL VBA QUESTION - PRETTY SIMPLE I SUSPECT

Since you are already using the Range object, get the color index from it:

If Range("A" & iRow).Font.ColorIndex = 43 Then

Or, if the first empty cell in the column indicates the end of the data, you could loop through the cells this way:

Sub CountCells()
    Dim iRow As Long, iCount As Long
    iRow = 1
    Do While Len(Range("A" & iRow).Text) > 0
        If Range("A" & iRow).Font.ColorIndex = 43 Then
            iCount = iCount + 1
        End If
        iRow = iRow + 1
    Loop
    MsgBox "There are " & iCount & " colored cells."
End Sub

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members! Already a Member? Login

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close