Excel VBA根据列名称和单元格值将边框分配给组

Question

I have the below code and I want to do the following:

Go through a specific column based on its name (example "Company") and to change the border based on the values in that column (example "CompanyA","CompanyB", "CompanyC" etc.) to be Thick Box Border. This means "Company A" (50 rows) would get a border and "Company B" (5 rows) would get a border and so on.

Can this be done? Ty in advance!

Sub DrawBorders() 

Dim rCell As Range 
Dim rRange As Range 

Set rRange = Range("A1", Range("A65536").End(xlUp)) 

For Each rCell In rRange 
    If Not IsEmpty(rCell) And _ 
    Not IsEmpty(rCell.Offset(1, 0)) Then 
        With rCell 
            If .Value <> .Offset(1, 0).Value Then 
                With .EntireRow.Borders(xlEdgeBottom) 
                    .LineStyle = xlContinuous 
                    .Weight = xlMedium 
                    .ColorIndex = xlAutomatic 
                End With 
            End If 
        End With 
    End If 
Next rCell 

End Sub 

Answer 1

I have adjusted my code to fit your request. This will only put borders around desired company types. You may need to add further error catching to the IF-Statements depending on your data you're processing.

Sub DrawBoarders()
    Dim rCell As Range
    Dim rRange As Range
    Dim Prev As String
    Dim MyCell As String
    Prev = ""

    Set rRange = Range("A2", Range("A65536").End(xlUp))
    Dim SpecificCompany(3) As String 'Using 3 companies (Company A, B, & C)
    'Array of desired company names
    SpecificCompany(0) = "CompanyA"
    SpecificCompany(1) = "CompanyB"
    SpecificCompany(2) = "CompanyC"


    If IsInArray(Range("A1"), SpecificCompany) Then 'Check 1st row
            With Range("A1").EntireRow.Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .Weight = xlMedium
                .ColorIndex = xlAutomatic
            End With
    End If

    For Each rCell In rRange
        If IsInArray(rCell.Value, SpecificCompany) And rCell.Value <> rCell.Offset(-1, 0).Value Then
            With rCell.EntireRow.Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .Weight = xlMedium
                .ColorIndex = xlAutomatic
            End With
        End If
        If Not IsEmpty(rCell) And _
        Not IsEmpty(rCell.Offset(1, 0)) Then
        If rCell.Value <> rCell.Offset(1, 0).Value Then
            With rCell.EntireRow.Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .Weight = xlMedium
                .ColorIndex = xlAutomatic
            End With
        End If
        End If
    Next rCell
End Sub

Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
    IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function