Merge cells

[Marilyn]

I'm updating an excel spreadsheet from Access 2000 and is
trying to format and merge the header across columns.
Whenever the mergecells property is encountered the
message "The selection contains multiple data values.
Merge into cells will keep the upper-left most data only".
Following is a sample of the code: Is there a more
efficient way to do this?

Set oRange = oSheet.Range("b1:d1")
With oRange
.Value = "Negotiated Current"
.MergeCells = True
.HorizontalAlignment = xlCenter
.Font.Bold = True
End With

Set oRange = oSheet.Range("e1:g1")
With oRange
.Value = "Actual Current"
.MergeCells = True
.HorizontalAlignment = xlCenter
.Font.Bold = True
end With

Set oRange = oSheet.Range("h1:j1")
With oRange
.Value = "Negotiated ITD"
.MergeCells = True
.HorizontalAlignment = xlCenter
.Font.Bold = True
end With

Set oRange = oSheet.Range("k1:m1")
With oRange
.Value = "Actual ITD"
.MergeCells = True
.HorizontalAlignment = xlCenter
.Font.Bold = True
end With

 

[Greg Wilson]

Try the following:

Sub FormatHeadings()
Dim oRange As Range, oSheet As Worksheet
Dim i As Integer, HeadingArr As Variant

Set oSheet = ActiveSheet
HeadingArr = Array("Negotiated Current", _
"Actual Current","Negotiated ITD", "Actual ITD")

For i = 2 To 11 Step 3
Set oRange = oSheet.Range(Cells(1, i), Cells(1, i + 2))
With oRange
.MergeCells = True
.Value = HeadingArr(Int((i + 1) / 3))
.HorizontalAlignment = xlCenter
.Font.Bold = True
End With
Next

End Sub

Regards,
Greg

 

[Greg Wilson]

I forgot the Option Base 1 declartion at the top of the
module. This is twice now. Sorry, I'm just not a
meticulous person.


Regards,
Greg