Forum Discussion

Compl9x's avatar
Compl9x
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 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.

 

 

developer
excel
Formulas and Functions
Macros and VBA
  • HansVogelaar's avatar
    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

6 Replies

Sort By
  • HansVogelaar's avatar
    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's avatar
      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's avatar
        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

Resources