Count and Highlight text cells

**mtx_22-3** · 07-22-2011, 02:47 PM

Hello,

I'm new to the forum but the search option didn't work so I started a new thread.

The worksheet I'm working on contains A:M columns with data. Every row contains information about one component. I want to no how many components I have of different types. So how many components are of CASE A or CASE B, etc. This description can be stated in one of the 22 columns, but there also the possibility that a description is stated twice in the same row. The description can be surrounded by other text.

The main idea I had was to count the cells containg this data and highlight the rows with this data. And if a discription is stated twice in a row then the color changes again. But I can't get it to work and there must be an easier way around it. So can some help me?

This is what I have so far (I warn you I'm new to vba so it might suck

):

Private Sub Worksheet_Activate()

    Dim component As Range
    Dim total_comp As Integer
  
    Set component = ActiveSheet.Range("A4:M65536")
    For Each cell In component
        If cell = "*CASE A*" Then
            total_comp = total_comp + 1
                If cell(component).Interior.ColorIndex = 3 Then
                cell(component).Interior.ColorIndex = 4
                Else: cell(component).Interior.ColorIndex = 3
                End If
        End If
    Next cell
    cell("C2") = total_comp
End Sub

thanks a lot!

**Mordred** · 07-22-2011, 03:03 PM

Hi mtx_22-3, I've reworked your code a little, the search is by no means fast because of the search criteria but it works.

Private Sub Worksheet_Activate()
    Dim component As Range, cell As Range, Found As Range
    Dim total_comp As Integer
    Set component = ActiveSheet.Range("A4:M65536")
    For Each cell In component
        Set Found = cell.Cells.Find("*CASE A*")
        If Not Found Is Nothing Then
            Debug.Print cell.Address
            total_comp = total_comp + 1
            cell.Interior.ColorIndex = 4
        Else: cell.Interior.ColorIndex = 3
        End If
    Next cell
    Cells(2, 3).Value = total_comp
End Sub

**Simon Lloyd** · 07-22-2011, 03:11 PM

Just a few tweaks, untested but try this

code supplied by Simon Lloyd
'22/07/2011
'Microsoft Office Help
Private Sub Worksheet_Activate()

    Dim component As Range
    Dim total_comp As Long, cnt As Long
    cnt = 0
    Set component = ActiveSheet.Range("A4:M" & ActiveSheet.Range("M" & Rows.Count).End(xlUp).Row)
    For Each cell In component
        If cell = "*CASE A*" And cnt = 0 Then
            total_comp = total_comp + 1
                If cell(component).Interior.ColorIndex = 3 Then
                cell(component).Interior.ColorIndex = 4
                Else: cell(component).Interior.ColorIndex = 3
                End If
                cnt = cnt + 1
        Else
        total_comp = total_comp + 1
                If cell(component).Interior.ColorIndex = 3 Then
                cell(component).Interior.ColorIndex = 4
                cell(component).Interior.Pattern = xlLightVertical
                Else: cell(component).Interior.ColorIndex = 3
                cell(component).Interior.Pattern = xlLightVertical
                End If
        End If
    Next cell
    cell("C2") = total_comp
End Sub