select case merge relative cells problem

[bruch04]

Hi folks. Here's a puzzle for you. I'm setting up an excel spreadsheet. Each row is a day of the year. The first column will contain cells that have the name of the month in them, and each "month cell" is merged over the number of days in that month. For example, in January, the first 30 rows are merged in Column A, and the merged cell says "January", and in Column B, B1=1...B30=30. And so on.

Each month has a different number of days, and since this is projected over several years, I also have to account for leap years. It's incredibly tedious to go through and enter 1...30 or 1...31 or 1...28 etc depending on what month it is, and then merge the applicable column A cells. It's no problem using the Edit > fill > Series tool to enter the dates in column B. But once I have that I want a macro that will be able to tell whether that month has 30, 31, 28 or 29 days, and depending on the "case", merge the correct number of cells next to them in column A. This is what I have so far, and I'm getting an object required error:

_____________________________________________

Public Sub mergecells()

Dim range As range
Dim c
Dim address As range
Dim activecell As range
Dim firstaddress As range
Dim lastday As range
Dim topday As range

With Worksheets("Test").range("B1:B500")
Set c = .Find(28, LookIn:=xlValues)
If Not c Is Nothing Then
firstaddress = c.address.Activate
lastday = activecell.Offset(3, 0).Activate
Do
Select Case lastday
'case1 if three days later is "31"
Case activecell.Day(Date) = 31
topday = activecell.Offset(0, -1)
lastday = activecell.Offset(-31, -1)
range("topday:lastday").Select
range("lastday").Activate
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.mergecells = False
End With
Selection.Merge

'if month has 30 days set range in A column to merge
Case activecell.Day(Date) = 1
topday = activecell.Offset(-1, -1)
lastday = activecell.Offset(-30, -1)
range("topday:lastday").Select
range("lastday").Activate
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.mergecells = False
End With
Selection.Merge

'if month has 29 days set range in A column to merge
Case activecell.Day(Date) = 2
topday = activecell.Offset(-2, -1)
lastday = activecell.Offset(-29, -1)
range("topday:lastday").Select
range("lastday").Activate
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.mergecells = False
End With
Selection.Merge

'if month has 28 days set range in A column to merge
Case Day(Date) = 3
topday = activecell.Offset(-3, -1)
lastday = activecell.Offset(-28, -1)
range("topday:lastday").Select
range("lastday").Activate
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.mergecells = False
End With
Selection.Merge
End Select
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.address <> firstaddress
End If

End With

End Sub
_________________________________________________

Any ideas? I'll admit I'm incredibly novice at vba and am still in the learning process, so the answer might be fairly obvious to you guys. Thanks to anyone who may take the time to look at this....

 

[PHV]

I'm getting an object required error
Any chance you could post the highlighted code when in debug mode ?
I guess this:
firstaddress = c.address.Activate
Shouldn't it be this ?
Set firstaddress = c
Same for this:
lastday = activecell.Offset(3, 0).Activate
instead of:
Set lastday = ActiveCell.Offset(3, 0)

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ222-2244