Excel VBA formatting ranges

Question

I have a sub that formats specific ranges on a sheet and I want to make it more efficient (it was copied from running the macro recorder and works fine). I Also want incorporate code so that if a column is added, typically in Column C to E, the formatting is not effected. Some pointers would be appreciated

Sub Format_Summary_Sheet()
'
' Format Summary Sheet Macro
'
Dim i1stSumRow As Integer

Sheets("Summary").Select    'Activate Summary sheet

Application.ScreenUpdating = True

    With ActiveSheet
        i1stSumRow = Cells(.Rows.Count, "I").End(xlUp).Row
        .Range("I" & (i1stSumRow)).Select
    End With

Range(Cells(11, 3), Cells(i1stSumRow - 2, 51)).Select

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone

        With Selection.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlMedium
        End With

        With Selection.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With

        With Selection.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With

        With Selection.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlMedium
        End With

        With Selection.Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With

Range(Cells(i1stSumRow - 2, 1), Cells(i1stSumRow - 2, 51)).Select

    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With

Range(Cells(11, 2), Cells(i1stSumRow - 2, 2)).Select 'Removes borders from Column B

    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone

Range(Cells(11, 6), Cells(i1stSumRow - 2, 6)).Select 'Removes borders from Column F

    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone

Range(Cells(11, 8), Cells(i1stSumRow - 2, 8)).Select 'Removes borders from Column H

    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone

Range(Cells(11, 17), Cells(i1stSumRow - 2, 17)).Select 'Removes borders from Column Q

    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone

Range(Cells(11, 24), Cells(i1stSumRow - 2, 24)).Select 'Removes borders from Column X

    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone

Range(Cells(11, 33), Cells(i1stSumRow - 2, 33)).Select 'Removes borders from Column AG

    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone

Range(Cells(11, 37), Cells(i1stSumRow - 2, 37)).Select 'Removes borders from Column AK

    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone

Range(Cells(11, 39), Cells(i1stSumRow - 2, 39)).Select 'Removes borders from Column AM

    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone

Range(Cells(11, 48), Cells(i1stSumRow - 2, 48)).Select 'Removes borders from Column AV

    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Range("H7").Select
Range("C10").Select

End Sub

Dan Wagner · Answer 1 · 2014-07-24T13:47:31.487

Based on your code, it looks like you repeat the Remove borders from a column action many times. Whenever I find myself using ctrl+c (copy) and ctrl+v (paste) more than a few times in a script, my D.R.Y. alarm goes off. (Here's a link to the Don't Repeat Yourself entry on Wikipedia.)

The below is untested:

Public Sub RemoveBorders(Target As Range)
    'skip this routine if the passed-in range is Nothing
    If Target Is Nothing Then Exit Sub

    'execute the border removal
    Target.Borders(xlInsideVertical).LineStyle = xlNone
    Target.Borders(xlInsideHorizontal).LineStyle = xlNone
    Target.Borders(xlEdgeTop).LineStyle = xlNone
    Target.Borders(xlEdgeBottom).LineStyle = xlNone
End Sub

By adding that public subroutine below your existing subroutine (or, even better, adding it to your module dedicated specifically to helpers), your Format_Summary_Sheet() code can now be streamlined with one-liners for the border removal process:

Sub Format_Summary_Sheet()

    Dim i1stSumRow As Integer
    Dim TempRange As Range
    Dim MySheet As Worksheet

    '... set references up front
    Set MySheet = ThisWorkbook.ActiveSheet
    'or, to improve this even more, assign the sheet by name:
    'Set MySheet = ThisWorkbook.Worksheets("CoolSheetName")

    '... doing other stuff

    'remove borders section
    With MySheet
        Set TempRange = .Range(.Cells(11, 2), .Cells(i1stSumRow - 2, 2)) '<~ col F
        Call RemoveBorders(TempRange)
        Set TempRange = .Range(.Cells(11, 6), .Cells(i1stSumRow - 2, 6)) '<~ col H
        Call RemoveBorders(TempRange)
        Set TempRange = .Range(.Cells(11, 17), .Cells(i1stSumRow - 2, 17)) '<~ col Q
        Call RemoveBorders(TempRange)
        '... repeat this pattern for columns X, AG, AK, AM and AV
    End With

    '... the rest of your code

End Sub

By DRYing up your script here, you wind up with code that's not only easier to read, but also easier to maintain. Now that your logic for removing borders is contained within a single routine, if you ever need to make a change you only need to do it once.

Thanks @Dan. I'll report back once I get a chance to make changes based on all the responses — Paul_S, Jul 24 '14 at 15:06

score 1 · Answer 2 · answered Jul 24 '14 at 12:16

The most likely culprit for a perceived inefficiency is that ScreenUpdating is enabled while you run the macro. Try bracketing the formatting code with Application.ScreenUpdating = false ... Application.ScreenUpdating = True.

In order to immunize the code from the addition of columns (or rows), create a named range for the cell block that should be formatted, and refer to that range as Names("RangeName").RefersToRange where "RangeName" is the NamedRange name (in double quotes, s it is a string literal).

Thanks @Pieter. I'd forgotten to set screen updating back to false after watching what was happening :-) — Paul_S, Jul 24 '14 at 13:10

score 0 · Answer 3 · edited May 23 '17 at 12:00

Get Rid of Select

The first thing I would do, since the code selects "specific ranges", is specify a named range and use that range object in your code instead of Select. As a general rule, usage of Select in your VBA code is to be avoided.

The easy way would be to simply manually create/edit the named range every time your range changes (e.g., set MyRange equal to =$C$11:$AY$19; change that as needed). Downside: if you have to perform the task a lot, making this change each time is a big time sink.

Instead, you could specify a dynamic named range defining the last used row in Column I using something like this as the formula (to make a named range, do Formulas->Define Name):

=INDEX($I:$I,MAX(($I:$I<>"")*(ROW($I:$I))))    'Note: works only in 2007 or above

Maybe call that LastI.

Then create another named range based on LastI that defines the larger range to be formatted:

=$C$11:INDEX($AY:$AY,ROW(LastI)-2)

Maybe call that one MyRange.

Now in VBA, you can do things like this using your named range:

Private Sub FormatAnyRange(MyRange As Range)

    With MyRange
        .Borders(xlDiagonalDown).LineStyle = xlNone

        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlMedium            
        End With

    End With

End Sub

Call the above procedure using a separate procedure like this:

Sub CallFormatAnyRange()

    Dim MyRange As Range

    Set MyRange = Range("MyRange")

    Call FormatAnyRange(MyRange)

End Sub

Note: you want to split this into two tasks (i.e. Subs) so that you can reuse the first procedure using ANY range you send to it. For example, if you want to format a manually selected range, you could create this procedure that sends the current Selection to your first procedure:

Sub FormatSelectedRange()

    Call FormatAnyRange(Selection)
    'Note this is likely to throw errors if you don't 
    'have a valid Range Object selected

End Sub

Testing

You can test to make sure your dynamic named ranges are working correctly by entering things like this (functions that take a range as an argument) in any cell:

=ROW(LastI)
=COLUMNS(MyRange)
=SUMPRODUCT(MySnappyDynamicRange)

Then do Formulas->Evaluate Formula->Evaluate. This will show you the actual cell range address your dynamic named range is resolving into.

There are several other things I would suggest doing as well (e.g, get rid of repetitive code, further split your procedure into different procedures as makes sense, etc etc), but this is a good place to start - it will clean things up quite a bit. Make it your goal to get rid of every appearance of Select; this will both make your code better, and create an opportunity for you to expand your VBA knowledge as well.

Thanks @Rick. I'll report back once I get a chance to make changes based on all the responses — Paul_S, Jul 24 '14 at 15:06

Excel VBA formatting ranges

3 Answers3