patternMinor
Dynamic ranges and page-formatting
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
```
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
This line:
may require you to add
Also added
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 completionSub 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 SubCode 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 SubContext
StackExchange Code Review Q#29593, answer score: 4
Revisions (0)
No revisions yet.