Reputation: 27
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
Upvotes: 1
Views: 3611
Reputation: 45231
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. Sub
s) 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.
Upvotes: 0
Reputation: 2713
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.
Upvotes: 2
Reputation: 11883
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).
Upvotes: 1