VBA Dynamic Ranges & Sheet Formatting

[hobbiton73]

Hi, I wonder whether someone could help me please.

I was fortunate enough to recieve some help with the following code. The script creates a worksheet and adds a column heading and various dynmaic named ranges.


Sub blah()
myNames = Array("LOB", "StaffName", "Task", "ProjectName", "ProjectID", "JobRole", "Month", "Actuals")
Set Ash = ActiveSheet
Set newsht = Worksheets.Add(after:=Worksheets(2))
newsht.Name = "AllData"
With newsht
With .Range("B3")
.Value = "Staff Name"
.Font.Bold = True
With .Interior
.ColorIndex = 37
.Pattern = xlSolid
End With

End With
With .Range("C3")
.Value = "Task"
.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

Unfortunately I've come across a problem with this, which I've been unable to resolve. When I run the code I receive a 'Subscript Out of Range' error and the debug highlights this line as the cause:


newsht.Range(cll.Address).Resize(Range(cll, cll.End(xlDown)).Rows.Count).Name = myNames(i)

In addition, I'd also like to add another column heading to C3.

I can adapt this:


With .Range("B3")
.Value = "Staff Name"
.Font.Bold = True
With .Interior
.ColorIndex = 37
.Pattern = xlSolid
End With
End With



With .Range("B3")
.Value = "Staff Name"
.Font.Bold = True
With .Interior
.ColorIndex = 37
.Pattern = xlSolid
End With

End With
With .Range("C3")
.Value = "Task"
.Font.Bold = True
With .Interior
.ColorIndex = 37
.Pattern = xlSolid
End With
End With

But I'm not sure whether this is the correct ways to do things.

I just wondered whether someone may be able to look at these and let me know where I'm going wrong.

Many thanks and Kind Regards

[p45cal]

Sub blah()
myNames = Array("LOB", "StaffName", "Task", "ProjectName", "ProjectID", "JobRole", "Month", "Actuals")
Set Ash = ActiveSheet
Set newsht = Worksheets.Add(after:=Worksheets(2))
newsht.Name = "AllData"
With newsht
With .Range("B3:C3") 'a bit shorter to do both cells at once
.Value = Array("Staff Name", "Task")
.Font.Bold = True
With .Interior
.ColorIndex = 37
.Pattern = xlSolid
End With
End With
With .Cells.Font
.Name = "Lucida Sans"
.Size = 10
'you can probably lose the commented-out lines below - they're probably the default on a new sheet.
' .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 'this is 14 cells, but you only have 8 names in myNames.. should this be ("B4:I4") instead?
newsht.Range(cll.Address).Resize(Range(cll, cll.End(xlDown)).Rows.Count).Name = myNames(i)
i = i + 1
Next cll
End Sub

[hobbiton73]

Hi @p45cal, thank you very much for taking the time to reply to my post and for posting the solution.

You are quite correct in that this line
For Each cll In Ash.Range("B4:O4").Cells should be "B4:I4". My apologies.

Your solution works great and exactly what I was looking for. I have found the way you've created the column headings particularly interesting.

Many thanks and kind regards