HiveBrain v1.2.0
Get Started
← Back to all entries
patternMinor

Dynamic ranges and page-formatting

Submitted by: @import:stackexchange-codereview··
0
Viewed 0 times
formattingrangespagedynamicand

Problem

I've put together the code below, which creates a new sheet in my workbook and applies dynamically-named ranges and page-formatting.

```
Sub UniqueOverheads()

Set rOverheadsList = Range([B4], [B4].End(xlDown))
Set rOverheadsActuals = Range([C4], [C4].End(xlDown))
Set rOApr = Range([D4], [D4].End(xlDown))
Set rOMay = Range([E4], [E4].End(xlDown))
Set rOJun = Range([F4], [F4].End(xlDown))
Set rOJul = Range([G4], [G4].End(xlDown))
Set rOAug = Range([H4], [H4].End(xlDown))
Set rOSep = Range([I4], [I4].End(xlDown))
Set rOOct = Range([J4], [J4].End(xlDown))
Set rONov = Range([K4], [K4].End(xlDown))
Set rODec = Range([L4], [L4].End(xlDown))
Set rOJan = Range([M4], [M4].End(xlDown))
Set rOFeb = Range([N4], [N4].End(xlDown))
Set rOMar = Range([O4], [O4].End(xlDown))

Worksheets.Add(after:=Worksheets(4)).Name = "Overheads"

Range("B3").Select
ActiveCell.FormulaR1C1 = "Overheads Code"
With Selection.Interior
.ColorIndex = 37
.Pattern = xlSolid
End With
Selection.Font.Bold = True
Cells.Select
With Selection.Font
.Name = "Lucida Sans"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With

ActiveWorkbook.Names.Add Name:="OverheadsList", RefersToR1C1:="=" & _
ActiveSheet.Name & "!" & rOverheadsList.Address(ReferenceStyle:=xlR1C1)

ActiveWorkbook.Names.Add Name:="OverheadsActuals", RefersToR1C1:="=" & _
ActiveSheet.Name & "!" & rOverheadsActuals.Address(ReferenceStyle:=xlR1C1)

ActiveWorkbook.Names.Add Name:="OApr", RefersToR1C1:="=" & _
ActiveSheet.Name & "!" & rOApr.Address(ReferenceStyle:=xlR1C1)

ActiveWorkbook.Names.Add Name:="OMay", RefersToR1C1:="=" & _
ActiveSheet.Name & "!" & rOMay.Address(ReferenceStyle:=xlR1C1)

ActiveWorkbook.Names.Add Name:="OJun", RefersToR1C1:="=" & _
ActiveShe

Solution

Try to avoid using Select. I have fixed that for you.

This line: Range(Cells(4, i + 2), Cells(Cells(Rows.Count, i + 2).End(xlUp).Row, i + 2)).Address(ReferenceStyle:=xlR1C1)

may require you to add Sheets("SheetName") separated by dot . before Range to specify the sheet you want the data to refer to.

Also added Columns.Autofit at the end to automatically resize column widths upon completion

Sub UniqueOverheads()

    Worksheets.Add(after:=Worksheets(4)).Name = "Overheads"

    With Sheets(Sheets.Count).Range("B3")
        .Value = "Overheads Code"
        .Interior.ColorIndex = 37
        .Interior.Pattern = xlSolid
        .Font.Bold = True
    End With
    With Sheets(Sheets.Count).Cells.Font
        .Name = "Lucida Sans"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With

    Dim names As Variant
    names = Array("OverheadsList", "OverheadsActuals", "OApr", "OMay", "OJun", "OJul", "OAug", "OSep", _
                  "OOct", "ONov", "ODec", "OJan", "OFeb", "OMar")

    For i = LBound(names) To UBound(names)
         ActiveWorkbook.names.Add Name:=names(i), RefersToR1C1:="=" & _
         ActiveSheet.Name & "!" & _
         Range(Cells(4, i + 2), Cells(Cells(Rows.Count, i + 2).End(xlUp).Row, i + 2)).Address(ReferenceStyle:=xlR1C1)
    Next i
    Columns.AutoFit
End Sub

Code Snippets

Sub UniqueOverheads()

    Worksheets.Add(after:=Worksheets(4)).Name = "Overheads"

    With Sheets(Sheets.Count).Range("B3")
        .Value = "Overheads Code"
        .Interior.ColorIndex = 37
        .Interior.Pattern = xlSolid
        .Font.Bold = True
    End With
    With Sheets(Sheets.Count).Cells.Font
        .Name = "Lucida Sans"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With

    Dim names As Variant
    names = Array("OverheadsList", "OverheadsActuals", "OApr", "OMay", "OJun", "OJul", "OAug", "OSep", _
                  "OOct", "ONov", "ODec", "OJan", "OFeb", "OMar")

    For i = LBound(names) To UBound(names)
         ActiveWorkbook.names.Add Name:=names(i), RefersToR1C1:="=" & _
         ActiveSheet.Name & "!" & _
         Range(Cells(4, i + 2), Cells(Cells(Rows.Count, i + 2).End(xlUp).Row, i + 2)).Address(ReferenceStyle:=xlR1C1)
    Next i
    Columns.AutoFit
End Sub

Context

StackExchange Code Review Q#29593, answer score: 4

Revisions (0)

No revisions yet.