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.

 

[Peter_SSs]

the code will be placed in worksheet_selection change even, because when user change the border, the cell will be selected.

Some comments about your suggestion and code:

• I would be reluctant to use the selection change event for this. It most likely means that the code will be running much more often than required. That would probably not cause a problem since the code may be exited early most times, but combined with the points below, just doesn't seem like an efficient way to go to me.
• "when user change the border, the cell will be selected." Not necessarily so. At the bottom of post #6 the OP showed what tool they were using to draw the borders. That tool can be used on any cell(s) and is not related to the current selection.
• Even if the actual cell was selected to draw the border, the selection change code would run immediately on that selection. That is, the code would run before the border was drawn. After the border was drawn, the count would not be updated until next time an appropriate cell was selected (which may be a long time - or never)

 

[GColeman]

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

Here is what worked. there are 4 ranges to calculate in total.

Private Sub CommandButton1_Click()

  Dim o As Range
  Dim s As Range
  Dim d As Range
  Dim m As Range
  Dim w As Long
  Dim x As Long
  Dim y As Long
  Dim z As Long
 
  For Each o In Range("E20:CV20")
    w = w - (o.DisplayFormat.Borders(xlBottom).Color = vbRed)
  Next o
  Range("DG19").Value = w / 4
 
  For Each s In Range("E23:CV23")
    x = x - (s.DisplayFormat.Borders(xlBottom).Color = vbRed)
  Next s
  Range("DG22").Value = x / 4
 
  For Each d In Range("E26:CV26")
    y = y - (d.DisplayFormat.Borders(xlBottom).Color = vbRed)
  Next d
  Range("DG25").Value = y / 4
 
  For Each m In Range("E29:CV29")
    z = z - (m.DisplayFormat.Borders(xlBottom).Color = vbRed)
  Next m
  Range("DG28").Value = z / 4
 
End Sub

 

[Peter_SSs]

Thanks for posting your solution.

A request for the future though: When posting vba code in the forum, please use the available code tags. It makes your code much easier to read/debug. My signature block below has more details. I have added them for you this time. ?

A couple of other comments.
You said the border was manually applied, not by Conditional Formatting, so the use of DisplayFormat is not required (though it will not hurt)
Nothing at all wrong with the way you have done it but since your ranges are uniformly spaced and equal size you could streamline the code a little like this perhaps.

Private Sub CommandButton1_Click()
  Dim Cell As Range
  Dim Rw As Long
  Dim w As Long

  For Rw = 20 To 29 Step 3
    w = 0
    For Each Cell In Intersect(Rows(Rw), Columns("E:CV"))
      w = w - (Cell.Borders(xlBottom).Color = vbRed)
    Next Cell
    Range("DG" & Rw - 1).Value = w / 4
  Next Rw
End Sub

 

[GColeman]

Thanks for posting your solution.

A request for the future though: When posting vba code in the forum, please use the available code tags. It makes your code much easier to read/debug. My signature block below has more details. I have added them for you this time. ?

A couple of other comments.
You said the border was manually applied, not by Conditional Formatting, so the use of DisplayFormat is not required (though it will not hurt)
Nothing at all wrong with the way you have done it but since your ranges are uniformly spaced and equal size you could streamline the code a little like this perhaps.

Private Sub CommandButton1_Click()
  Dim Cell As Range
  Dim Rw As Long
  Dim w As Long

  For Rw = 20 To 29 Step 3
    w = 0
    For Each Cell In Intersect(Rows(Rw), Columns("E:CV"))
      w = w - (Cell.Borders(xlBottom).Color = vbRed)
    Next Cell
    Range("DG" & Rw - 1).Value = w / 4
  Next Rw
End Sub

You're right, that would probably simplify it. I haven't done much with VBA in years, so I'm trying to re-learn what little I had. The code I used was given given as an example for one that worked, so I simply repeated it 4 times. I can wrap my head around that. This one, I get now that I see it. But the other is at my level. If I have issues (which i had a number of them as the page developed) I was able to easier understand it for troubleshooting.
I appreciate all of the help.

 

[Peter_SSs]

No problem, and I agree that provided a code does what you want and it does it fast enough, you are better off with the one you understand the best since that give you the best chance of being able to modify it yourself in the future if required.

 

[GColeman]

Ok. So unexpected issue. Human inconsistency. Is there a way to limit the user to applying ONLY a red border with XL thick line? I was hoping a simple macro would do to open the “Borders” tab and select line and color, but as you can guess that did not work. It doesn’t record any steps until you select a cell. I could work with that, except it doesn’t retain the line settings after the macro finishes. What I’m looking for is for the user to select a CmdButton and have it set them up to apply XLThick Red border in the required cells.

Am I asking too much? I mean, I could easily create a MsgBox or User Form that lays out the instructions step by step. But they’d have to actually read and follow it.