Okay, I needed to make a couple of assumptions. First, I assumed that you
have a real date in the first column of your date row and all the other
dates in that row are generated by a formula that adds one to the previous
column. This way, changing a single cell (the first column of the date row)
will change all the other dates automatically; so I keyed the solution onto
your changing that cell only. Second, I assumed you will *never* have a date
(in the date row) in the *last* column in the spreadsheet. Copy/Paste all
the code below into the worksheet's code window where you want this
functionality (right click the worksheet's tab, select View Code in order to
bring up the proper window). Immediately after you paste the code into the
code window, change the two Const statements at the very beginning of the
code to reflect your actual worksheet layout. The DateRow constant is the
row where the dates are located and the StartColumn is the column number of
the first date in that row. After you have done that, go to the worksheet
and enter a date into that first date cell.... you should see the merged
areas you requested (plus I placed a border around them).
'*************** START OF CODE ***************
Private Const DateRow As Long = 2
Private Const StartColumn As Long = 3
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = Cells(DateRow, StartColumn).Address Then
AddMergedMonthNames
End If
End Sub
Sub AddMergedMonthNames()
Dim X As Long
Dim LastColumn As Long
Dim CurrentMonth As Long
Dim CurrentColumn As Long
LastColumn = Cells(DateRow, Columns.Count).End(xlToLeft).Column
Cells(DateRow, LastColumn + 1).Value = _
Cells(DateRow, LastColumn).Value + 32
CurrentColumn = StartColumn
CurrentMonth = Month(Cells(DateRow, CurrentColumn).Value)
Rows(DateRow + 1).Clear
For X = StartColumn + 1 To LastColumn + 1
If Month(Cells(DateRow, X).Value) <> CurrentMonth Then
Cells(DateRow + 1, CurrentColumn).Value = MonthName(CurrentMonth)
Cells(DateRow + 1, CurrentColumn).Resize(1, X - CurrentColumn).Merge
True
Cells(DateRow + 1, CurrentColumn).MergeArea.BorderAround xlContinuous,
xlMedium
CurrentMonth = Month(Cells(DateRow, X).Value)
CurrentColumn = X
End If
Next
Cells(DateRow, LastColumn + 1).Clear
End Sub
'*************** END OF CODE ***************