Forum Discussion

Copper Contributor

May 07, 2024

Solved

Excel VBA - Count Cells with Borders

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 ce...

developer

excel

Formulas and Functions

Macros and VBA

HansVogelaar

May 07, 2024

Compl9x

Yes, that's a minor modification:

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

HansVogelaar

MVP

May 07, 2024

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)

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

Compl9x

Copper Contributor

May 07, 2024

Thank you so much! One clarification, I was looking for Border color, not fill color. Is this an easy change?

HansVogelaar

MVP

May 07, 2024

Compl9x

Yes, that's a minor modification:

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

Compl9x
Copper Contributor
May 07, 2024
That's perfect! You mentioned the numers for green and blue. Does it support the Excel default light blue as well?