CODEWITHSUNDEEP
vbaexcel
Kurt Olsen
Kurt Olsen

Reputation: 1

Selecting multiple variable cell ranges in Excel with VBA to draw borders

I have a tab that automatically receives data extracted from another part of the spreadsheet. There are always three columns with data for the report: col A has task descriptions, col B has labor numbers, and col C has expense numbers. Col F has a number representing the number of rows in that section (which will be different every time, but it's coming in with the extraction - no calculation required).

I simply want to draw borders around each section, by column. So if I am doing it manually, I select A2:A7 and select Outside Borders. Then I select B2:B7 and do the same thing. Then C2:C7 and repeat. I know how many rows are involved because that number is in column F.

Then I go to the next section and do the same thing, but the number of rows will likely be different, but identified in column F.

The process would be repeated until all sections are outlined. There could be 3 sections, or 20. I think I could loop the sequence based on the count of data entries in column F.

Here are links to before and after:

Excel border automation - before

Excel border automation - after

Upvotes: 0

Views: 923

Answers (2)

Davesexcel
Davesexcel

Reputation: 6984

Check it out. Here's a sample workbook

Sub Button1_Click()
    Dim findrow As Long, findrow2 As Long
    Dim rw1 As Long, rw2 As Long, i As Integer
    Dim Brng As Range

    On Error GoTo errhandler
    x = WorksheetFunction.CountIf(Range("A:A"), "*Phase*")
    rw1 = Cells(Rows.Count, "A").End(xlUp).Row

    For i = 2 To x + 1
        If findrow <> 0 Then
            findrow = findrow2
        Else
            findrow = Range("A1:A" & rw1 + findrow2).Find("*Phase*", lookat:=xlWhole).Row + rw2
        End If
        rw2 = findrow + 1
        If i = x + 1 Then
            findrow2 = rw1 + 1
        Else
            findrow2 = Range("A" & rw2 & ":A" & rw1).Find("*Phase*", lookat:=xlWhole).Row
        End If
        Set Brng = Range("A" & findrow & ":A" & findrow2 - 1)
        With Brng
            .Borders(xlEdgeLeft).LineStyle = xlContinuous
            .Borders(xlEdgeRight).LineStyle = xlContinuous
            .Borders(xlEdgeBottom).LineStyle = xlContinuous
            .Borders(xlEdgeTop).LineStyle = xlContinuous
        End With
        With Brng.Offset(0, 1)
            .Borders(xlEdgeLeft).LineStyle = xlContinuous
            .Borders(xlEdgeRight).LineStyle = xlContinuous
            .Borders(xlEdgeBottom).LineStyle = xlContinuous
            .Borders(xlEdgeTop).LineStyle = xlContinuous
        End With
        With Brng.Offset(0, 2)
            .Borders(xlEdgeLeft).LineStyle = xlContinuous
            .Borders(xlEdgeRight).LineStyle = xlContinuous
            .Borders(xlEdgeBottom).LineStyle = xlContinuous
            .Borders(xlEdgeTop).LineStyle = xlContinuous
        End With
    Next i

    Exit Sub

errhandler:
    MsgBox "No Cells containing specified text found"

End Sub

Upvotes: 0

Grade &#39;Eh&#39; Bacon
Grade &#39;Eh&#39; Bacon

Reputation: 3823

Don't use VBA for this - use conditional formatting instead. Go to Conditional Formatting -> Add New Rule -> Custom Formula and, selecting columns A, B, and C, type the following formula:

=NOT(ISBLANK(A1))

This will look at each individual cell in those columns. If any one of those cells has any value in it, the formula above will resolve as TRUE. This means the conditional format rule you specify will apply. You then add formatting within the rule, so that there is a border on the right and left sides of the cell.

Then add another rule which says:

=AND(NOT(ISBLANK(A1)),ISBLANK(A2))

This will resolve as TRUE, when a particular cell has a value, but the one below it does not. Add in a format which makes the bottom border visible.

Upvotes: 1

Related Questions