hobbiton73
08-10-2013, 07:25 AM
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
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