VBA Dynamic Named Ranges & Page Formatting

[hobbiton73]

Hi, I wonder whether someone may be able to help me please.

I've put together the code below which creates new sheet and applies dynamic 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))


'This creates the "Enhancements" sheet, copies the header row from the "All Data" sheet and pastes into the "Projects" sheet.


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:="=" & _
ActiveSheet.Name & "!" & rOJun.Address(ReferenceStyle:=xlR1C1)


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


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


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


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


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


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


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


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


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

End Sub


The code works fine, but I'm still relatively new to VBA, and I think that the way I've written it may be a little 'clunky',

I just wondered whether someone, who is a more seasoned programmer than I and offer some guidance on perhaps a smarter way of coding whilst maintain the same functionality.

Many thanks and kind regards

[p45cal]

lots of ways to do this, one:
Sub blah()
myNames = Array("OverheadsList", "OverheadsActuals", "OApr", "OMay", "OJun", "OJul", "OAug", "OSep", "OOct", "ONov", "ODec", "OJan", "OFeb", "OMar")
Set Ash = ActiveSheet
Set newsht = Worksheets.Add(after:=Worksheets(4))
newsht.Name = "Overheads"
With newsht
With .Range("B3")
.Value = "Overheads Code"
.Font.Bold = True
With .Interior
.ColorIndex = 37
.Pattern = xlSolid
End With
End With
With .Cells.Font
.Name = "Lucida Sans"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
End With
i = 0
For Each cll In Ash.Range("B4:O4").Cells
newsht.Range(cll.Address).Resize(Range(cll, cll.End(xlDown)).Rows.Count).Name = myNames(i)
i = i + 1
Next cll
End Sub

[SamT]

???

Sub UniqueOverheads()


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

'This creates the "Enhancements" sheet, copies the header row from the "All Data" sheet and pastes into the "Projects" sheet.


Worksheets.Add(after:=Worksheets(4)).Name = "Overheads"
frm1st = "=" & ActiveSheet.Name & "!" 'First part of Formula


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

With ActiveWorkbook.Names
.Add Name:="OverheadsList", RefersToR1C1:=frm1st & rOverheadsList
.Add Name:="OverheadsActuals", RefersToR1C1:=frm1st & rOverheadsActuals
.Add Name:="OApr", RefersToR1C1:=frm1st & rOApr
.Add Name:="OMay", RefersToR1C1:=frm1st & rOMay
.Add Name:="OJun", RefersToR1C1:=frm1st & rOJun
.Add Name:="OJul", RefersToR1C1:=frm1st & rOJul
.Add Name:="OAug", RefersToR1C1:=frm1st & rOAug
.Add Name:="OSep", RefersToR1C1:=frm1st & rOSep
.Add Name:="OOct", RefersToR1C1:=frm1st & rOOct
.Add Name:="ONov", RefersToR1C1:=frm1st & rONov
.Add Name:="ODec", RefersToR1C1:=frm1st & rODec
.Add Name:="OJan", RefersToR1C1:=frm1st & rOJan
.Add Name:="OFeb", RefersToR1C1:=frm1st & rOFeb
.Add Name:="OMar", RefersToR1C1:=frm1st & rOMar
End With
End Sub

[hobbiton73]

Hi @p45cal, many thanks for taking the time to reply to my post and for the solution, it's great to get some advice from someone who know what they're doing!

Kind Regards

[hobbiton73]

Hi @SamT, many thanks for taking the time to help me out with this. As with @p45cal, it's great to get some guidance from someone who knows what they're talking about.

Kind Regards