SOLVED

Excel VBA - Count Cells with Borders

Copper Contributor

Hello, I'm looking to create 3 new functions via Excel VBA which solve the following purposes:

1. Count cells that are completely surrounded by borders (Top, bottom, left, and right)

 

2. Count cells that are completely surrounded by borders, with text in the cell.

 

3. Count cells that are completely surrounded by borders (Top, bottom, left, and right) that are a certain color (red)

I also need the formula for black and blue, but I'm assuming I can change the "Red" to a different color after.

 

Thanks for help on any of these formulas. I have very little experience with VBA, and all of my research and code I have written do not work.

 

 

6 Replies
You will need VBA coding.

@Compl9x 

Here is a function that does all three.

Function CountBordered(Rng As Range, Optional SkipBlank As Boolean, Optional FillColor) As Long
    Dim Cel As Range
    For Each Cel In Rng
        If Cel.Borders(xlEdgeTop).LineStyle <> xlLineStyleNone And _
                Cel.Borders(xlEdgeLeft).LineStyle <> xlLineStyleNone And _
                Cel.Borders(xlEdgeBottom).LineStyle <> xlLineStyleNone And _
                Cel.Borders(xlEdgeRight).LineStyle <> xlLineStyleNone And _
                (Cel.Value <> "" Or Not SkipBlank) Then
            If Not IsMissing(FillColor) Then
                If Cel.Interior.Color = FillColor Then
                    CountBordered = CountBordered + 1
                End If
            Else
                CountBordered = CountBordered + 1
            End If
        End If
    Next Cel
End Function

To count cells that are surrounded by borders in A1:C6:

=CountBordered(A1:C6)

To count non-empty cells that are surrounded by borders in A1:C6:

=CountBordered(A1:C6, TRUE)

To count cells with red fill that are surrounded by borders in A1:C6:

=CountBordered(A1:C6, , 255)

To count non-empty cells with red fill that are surrounded by borders in A1:C6:

=CountBordered(A1:C6, TRUE, 255)

HansVogelaar_0-1715081449185.png

For green, use 65280, and for blue, use 16711680 instead of 255.

Thank you so much! One clarification, I was looking for Border color, not fill color. Is this an easy change?
best response confirmed by Compl9x (Copper Contributor)
Solution

@Compl9x 

Yes, that's a minor modification:

HansVogelaar_0-1715105876767.png

Code:

Function CountBordered(Rng As Range, Optional SkipBlank As Boolean, Optional LineColor) As Long
    Dim Cel As Range
    For Each Cel In Rng
        If Cel.Borders(xlEdgeTop).LineStyle <> xlLineStyleNone And _
                Cel.Borders(xlEdgeLeft).LineStyle <> xlLineStyleNone And _
                Cel.Borders(xlEdgeBottom).LineStyle <> xlLineStyleNone And _
                Cel.Borders(xlEdgeRight).LineStyle <> xlLineStyleNone And _
                (Cel.Value <> "" Or Not SkipBlank) Then
            If Not IsMissing(LineColor) Then
                If Cel.Borders(xlEdgeTop).Color = LineColor And _
                        Cel.Borders(xlEdgeLeft).Color = LineColor And _
                        Cel.Borders(xlEdgeBottom).Color = LineColor And _
                        Cel.Borders(xlEdgeRight).Color = LineColor Then
                    CountBordered = CountBordered + 1
                End If
            Else
                CountBordered = CountBordered + 1
            End If
        End If
    Next Cel
End Function

That's perfect! You mentioned the numers for green and blue. Does it support the Excel default light blue as well?

@Compl9x 

Yep. That's 15773696

How to find out?

Select a cell with the border color you want.

Activate the Visual Basic Editor.

Press Ctrl+G to activate the Immediate window.

Type

? ActiveCell.Borders(xlEdgeTop).Color

and press Enter.

You can copy this number and paste it into the formula.

 

1 best response

Accepted Solutions
best response confirmed by Compl9x (Copper Contributor)
Solution

@Compl9x 

Yes, that's a minor modification:

HansVogelaar_0-1715105876767.png

Code:

Function CountBordered(Rng As Range, Optional SkipBlank As Boolean, Optional LineColor) As Long
    Dim Cel As Range
    For Each Cel In Rng
        If Cel.Borders(xlEdgeTop).LineStyle <> xlLineStyleNone And _
                Cel.Borders(xlEdgeLeft).LineStyle <> xlLineStyleNone And _
                Cel.Borders(xlEdgeBottom).LineStyle <> xlLineStyleNone And _
                Cel.Borders(xlEdgeRight).LineStyle <> xlLineStyleNone And _
                (Cel.Value <> "" Or Not SkipBlank) Then
            If Not IsMissing(LineColor) Then
                If Cel.Borders(xlEdgeTop).Color = LineColor And _
                        Cel.Borders(xlEdgeLeft).Color = LineColor And _
                        Cel.Borders(xlEdgeBottom).Color = LineColor And _
                        Cel.Borders(xlEdgeRight).Color = LineColor Then
                    CountBordered = CountBordered + 1
                End If
            Else
                CountBordered = CountBordered + 1
            End If
        End If
    Next Cel
End Function

View solution in original post