CODEWITHSUNDEEP
vbaexcel
sc1324
sc1324

Reputation: 600

add border to dynamic range vba

I have a excel file with raw data broken into ranges, and what is fixed is the data has 6 columns and data starts with 2 rows below the headers.

I am getting new data each week so each range (or chunk of data) has different sizes meaning last used row and last used column will vary. I have posted a sample data so you get an idea, and I only posted 3 ranges so it fits fine in the picture; and desired results.

This is part of the larger codes I have written, so I am hoping to achieve this by writing vba codes.

My task is to add border to each range but only the data portion, and I am getting error of Loop without Do. 

Sub test()

Dim d, e As Long
Dim c As Range

With Sheet1.Rows(3)
    Set c = .Find("Status", LookIn:=xlValues)

     If Not c Is Nothing Then
            firstAddress = c.Address
            With c
                d = Cells.SpecialCells(xlCellTypeLastCell).Row
                e = c.row
            End With
                Do
           With c.Offset(d-e+2, 6)
                 With .Borders(xlEdgeLeft)
                    .LineStyle = xlContinuous
                    .Weight = xlMedium
                    .ColorIndex = xlAutomatic
                End With
                With .Borders(xlEdgeTop)
                    .LineStyle = xlContinuous
                    .Weight = xlMedium
                    .ColorIndex = xlAutomatic
                End With
                With .Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                    .Weight = xlMedium
                    .ColorIndex = xlAutomatic
                End With
                With .Borders(xlEdgeRight)
                    .LineStyle = xlContinuous
                    .Weight = xlMedium
                    .ColorIndex = xlAutomatic
                End With

                Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> firstAddress
            End With
       End If

End With
End Sub

enter image description here

enter image description here

Upvotes: 0

Views: 2320

Answers (3)

jeffreyweir
jeffreyweir

Reputation: 4824

Convert your ranges to Excel Tables (aka ListObjects) and use the built in formatting that they offer. Table Styles can be altered to show whatever you want, including just a simple border.

When in doubt, refer to the serenity prayer for VBA:

Lord grant me the VBA skills to automate the things I cannot easily change; the knowledge to leverage fully off the inbuilt features that I can; and the wisdom to know the difference.

Upvotes: 0

user6432984
user6432984

Reputation:

The best way to go about solving a problem is to break it down to individual testable components. 

Sub NewTest()
    Dim cell As Range, list As Object
    Set list = getFindCells(Sheet1.Rows(3))
    For Each cell In list
        FormatRange Intersect(cell.CurrentRegion.Offset(2), cell.CurrentRegion)
    Next
End Sub

Sub FormatRange(Target As Range)
    With Target
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
    End With
End Sub

' https://msdn.microsoft.com/en-us/vba/excel-vba/articles/range-find-method-excel
Function getFindCells(Target As Range) As Object
    Dim c As Range, list As Object
    Dim firstAddress As String
    Set list = CreateObject("System.Collections.ArrayList")

    With Target
        Set c = .Find(2, LookIn:=xlValues)
        If Not c Is Nothing Then
            firstAddress = c.Address
            Do
                list.Add c
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
    End With
    Set getFindCells = list
End Function

Upvotes: 0

Calico
Calico

Reputation: 416

I took the same approach as you but made a few modifications to reduce the lines of code. Hopefully it does what you need. Let me know

Sub BorderData()
Dim c As Range
Dim firstaddress As String
Dim ws1 As Worksheet

Set ws1 = Sheets("Sheet1")

With ws1.Rows(3)
    Set c = .Find("Status", LookIn:=xlValues)
    If Not c Is Nothing Then
        firstaddress = c.Address
        Do
            ws1.Range(c.Offset(2), c.End(xlDown).End(xlToRight)).BorderAround LineStyle:=xlContinuous, Weight:=xlThick
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstaddress
    End If
End With

End Sub

Upvotes: 4

Related Questions