Countif border of a cell is red

[GColeman]

Hey everyone, this should be an easy one for someone. I just need a simple code to count how many cells in a range (E26:BD26) have a red top border. I’ve found threads on changing border colors, counting by cell value, etc. But I just want to count red borders. 1 cell returns a value of .25 (I’m counting 15 minute segments and need total in hours. Ex. 6 cells counted at .25 = 1.5. It’ll run off a CommandButton. I don’t have an example that was even close, or I’d post it.

 

[Michael M]

Maybe this way...UNTESTED

Sub RedOutlineCells()
    Dim cell As Range, n As Integer
For Each cell In Range("E26:BD26")
        If cell.Borders(xlTop).ColorIndex = 3 Then n = n + 1
Next cell
MsgBox "there are " & n & " cells with red top borders"
End Sub

 

[Peter_SSs]

It’ll run off a CommandButton.

Where will the result go?
Would turning the code into a user-defined function be any use? Then you could use it in the worksheet itself - like shown below.
I have also added the conversion to hours.

Function TotHrs(rng As Range) As Double
  Dim c As Range
  
  For Each c In rng
    TotHrs = TotHrs - (c.Borders(xlTop).Color = vbRed)
  Next c
  TotHrs = TotHrs / 4
End Function

 

[GColeman]

The result will go in a cell at the end of the range. It doesn’t have to be a CmdButton. It can run as a function or even on a change in value of a particular cell. Say, the last data entry on the sheet. I’m not fussy. I just thought a “CALCULATE” user button would be easy.
I will hopefully get a chance to try the suggestions tomorrow and will let you know. I appreciate the assistance.

 

[Peter_SSs]

The result will go in a cell at the end of the range. It doesn’t have to be a CmdButton. It can run as a function or even on a change in value of a particular cell. Say, the last data entry on the sheet.

I'm guessing then that the range in question could change(?) and if you want the result at the end of the range then a function used in the worksheet itself like I suggested may not be the best way and your idea of a button may make more sense.

So, is the range E26:BD26 actually fixed or was that just an example?
Is the calculation just for this one row or are there a number of rows that need to be calculated separately?

Also forgot to mention last time that the suggestions so far will not work if the red border is the result of Conditional Formatting. If that was the case, or could be, then either

• Change the code to something like this
  
  

  Sub Tot_Hrs()
    Dim c As Range
    Dim x As Long
  
    For Each c In Range("E26:BD26")
      x = x - (c.DisplayFormat.Borders(xlTop).Color = vbRed)
    Next c
    Range("BE26").Value = x / 4
  End Sub

  
  or
  
  
• If the red is Conditional Formatting then there may well be a worksheet function that could do the calculation for you. If it is CF then please advise what the CF rule is

 

[GColeman]

The first range is actually E30:CV30. The total will go in DE30. If it calculates as a function, that’s where it will be. Four separate ranges in total, all identical in length, and fixed. The red line is a red border from the Font tab in the ribbon. Always the same color, thickness and style. It ends up looking like a very thin horizontal bar graph. There is no Conditional Formatting in any cell in the ranges.

Private Sub CommandButton1_Click()
Dim c As Range
Dim x As Long
For Each c In Range("E30:CV30")
x = x - (c.DisplayFormat.Borders(xlTop).Color = vbRed)
Next c
Range("DD30").Value = x / 4
End Sub

This one works close for what I thought I wanted. Two things. First, I now find it will work better as a Worksheet_Change, but when I do this:

Private Sub Worksheet_Change(ByVal Target as Range)

It crashes Excel.

Second, the code only works if the 4 outside borders are all red. If it's just the top one, It doesn't count it.
I made a simplified version to illustrate.

We are using this to draw a single line

If we use the exact same option but expand it to all outside borders, it works. Just a single border, it doesn't.

 

[Peter_SSs]

I now find it will work better as a Worksheet_Change

Just so long as you are aware that drawing a border will not trigger the Worksheet_Change event code to update your count.

I made a simplified version to illustrate.

Unfortunately we cannot see what rows or columns are in those ranges.
Are you sure that you have added a top border to the cell you want to count and not a bottom border to the cell above (it would look the same).

 

[GColeman]

Just so long as you are aware that drawing a border will not trigger the Worksheet_Change event code to update your count.



Unfortunately we cannot see what rows or columns are in those ranges.
Are you sure that you have added a top border to the cell you want to count and not a bottom border to the cell above (it would look the same).

I understand that it would have to be a change within a cell to trigger, and not just a format change. But I appreciate you pointing that out for clarity. ??
The specific addresses of the cells aren’t overly crucial, as the code you provided proves that the range is properly identified when the whole cell is bordered in red. But I can include it all if that helps. As far as the border location, I had considered that. It is along the top of the row of cells identified in the range, and does not show a count. When I extend it to the whole cell in the range (below the border), it does. My thought on this is perhaps when a single line is drawn it is Excel’s default that when given the need to choose, it is identified as only a bottom border of “cell A” and not as a bottom border of “cell A” AND the top border of “cell B”. To test this I will adjust the prescribed range to be the cells above, and then ask it to count bottom borders rather than top. If that proves true, it would be a viable workaround. Hopefully this evening I’ll be able to test this.

 

[GColeman]

I understand that it would have to be a change within a cell to trigger, and not just a format change. But I appreciate you pointing that out for clarity. ??
The specific addresses of the cells aren’t overly crucial, as the code you provided proves that the range is properly identified when the whole cell is bordered in red. But I can include it all if that helps. As far as the border location, I had considered that. It is along the top of the row of cells identified in the range, and does not show a count. When I extend it to the whole cell in the range (below the border), it does. My thought on this is perhaps when a single line is drawn it is Excel’s default that when given the need to choose, it is identified as only a bottom border of “cell A” and not as a bottom border of “cell A” AND the top border of “cell B”. To test this I will adjust the prescribed range to be the cells above, and then ask it to count bottom borders rather than top. If that proves true, it would be a viable workaround. Hopefully this evening I’ll be able to test this.

That appears to have fixed it. I’ll tweak it a bit, and post the full code soon

 

[bebo021999]

According image in #6, you are trying to count "lower border", not "top boder"
But your words said "top border"
I tried with "top border" first.
the code will be placed in worksheet_selection change even, because when user change the border, the cell will be selected.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim count&, rng As Range, cell As Range
If Intersect(Target, Range("E30:CV300")) Is Nothing Then Exit Sub
Set rng = Range(Cells(Target.Row, "E"), Cells(Target.Row, "CV"))
    For Each cell In rng
        If cell.Borders(xlEdgeTop).ColorIndex = 3 Or cell.Borders.ColorIndex = 3 Then count = count + 1
    Next
    With Cells(Target.Row, "DD")
        If count > 0 Then
            .Value = count / 4
        Else
            .Value = ""
        End If
    End With
End Sub