[RESOLVED] Automate Some Cell Formatting in Excel 2002

[MartinLiss]

I have a spreadsheet that contains two identical sheets with headings like this


Row 2 is formatted as Custom 'dd' and cell C2 has the formula '1+B2'. Cell D2 has the formula '1+C2', etcetera out to cell AQ2 which has the formula 1+AP2 and so back on December 20 I put '12/20/2011' in cell B2 which generated the values in the rest of the row.

Cell B3 has the formula =LEFT(TEXT(B2,"ddd"),1), and C3 has the formula =LEFT(TEXT(C2,"ddd"),1), etcetera so the letters for the days are automatically generated when I put the current date in cell B2.

I normally generate new sheets when the days reach the end of the chart so on the 31st of January I should have done the following to produce new sheets. (I'm a few days behind).

1. Select the merged cell that contains 'Dec-11' and Format|Cells|Alignment and uncheck 'Merge cells'. Do the same for the merged cell that contains 'Jan-12' and if there had been a 3rd merged cell as there sometimes is, do the same for it.
2. Remove the dates that remain in row 1 from the 2 (or 3) cells.
3. The cells that separated the months (N1, N2 and N3) are formatted so that their left side has a dark border and I would remove that by selecting, say, cells P1, 2 and 3, and Copy|Paste Special|Formats to N1, 2 and 3. I would do the same for the second set of month separating cells if there was one.
4. I would then put the current date (or in this case since I'm behind, 1/31/2011) in cell B2 to generate the new day numbers and letters resulting in this.
   
5. January is a one-column (column B) month this time so let's ignore it for a minute. I would then select cells C1:AD1 that represent February and Format|Cells|Alignment and check 'Merge cells' and enter '02/2012' which would be changed to 'Feb-12' because the row is formatted as Date of type 'Mar-01'. I'd do the same for cells AE1:AQ1 and enter '03/2012'. Since cell B1 which represents January is too small to hold 'Jan-11' I would just enter a 'J'.
6. Then I would select cells C1:C3 and select the 'Left border' icon from the 'Borders' menu and do the same for AE1:AE3 giving me this
   
7. Finally I would copy rows 1, 2 and 3 from Sheet1 to Sheet2.

I'd be very grateful if someone could show me the code for a button (at, say, column C, row 40 on sheet1) that would request the starting date (default of current date), put that date in cell B2 and then do steps 1 through 7.

[opus]

I know I'm fighting the setting, however without the merging of the cells in row 1 for each month you could do the rest (which is just the msarking of the cell where a new month starts) by using a conditional formating. The Rule would look like this

=MONTH(A$2)<>MONTH(B$2)

It should be used for all cells (in Row 1 to 3) except the one in Column 1.

I'll keep the line problem in mind, just give me some time on that one.
Would you take the entry in line1 if the month would be displayed above day 01 of the month?

I do like to do some coding in VBA, but why do coding when Excel does it by its own formulas!

[MartinLiss]

I know I'm fighting the setting, however without the merging of the cells in row 1 for each month you could do the rest (which is just the msarking of the cell where a new month starts) by using a conditional formating. The Rule would look like this

=MONTH(A$2)<>MONTH(B$2)

It should be used for all cells (in Row 1 to 3) except the one in Column 1.

I'll keep the line problem in mind, just give me some time on that one.
Would you take the entry in line1 if the month would be displayed above day 01 of the month?

I do like to do some coding in VBA, but why do coding when Excel does it by its own formulas!

Thanks but I really want to keep the formatting (merged cells, and the left, dark, border of the cells which transition to a new month).

Did you mean =MONTH(B$2)<>MONTH(C$2) rather than =MONTH(A$2)<>MONTH(B$2) since column 'A' isn't involved with this? In any case I don't understand what that would do. And when you talk about "displayed above day 01 of the month", it is, it's just that the cells are merged so the 'Feb-12' etcetera is automatically centered.

[westconn1]

feb 12 has 29
the rest is more or less straight forward, most of the steps can be done recording a macro, which can be used in a procedure
step 1 can be skipped if a new blank sheet is added

i will try to do some of this later, no time now

[MartinLiss]

feb 12 has 29
the rest is more or less straight forward, most of the steps can be done recording a macro, which can be used in a procedure
step 1 can be skipped if a new blank sheet is added

i will try to do some of this later, no time now

You're right about Feb 29th. I'm very surprised that the Excel formula =1+AD2 that's in AE2 didn't pick that up!

As for a macro, yes, I thought about that but wouldn't that work only if the chart were the same each time I updated it?

[opus]

I have a macro for doing your Row1 stuff

Public Sub ShowMonthAndYear()
'Will erase the old entries in Row1 and
'will display updated Month and Year in merged cells on top of each month
Range("1:1").MergeCells = False
Dim CurCol As Integer
Dim StartMonth As Integer 'First Column for this Month
Dim EndMonth As Integer 'Last Column for this Month
CurCol = 2
'find first and lat Column for the month
With ThisWorkbook.ActiveSheet
    StartMonth = CurCol
    Do
        CurCol = CurCol + 1
        If Month(.Cells(2, CurCol)) <> Month(.Cells(2, StartMonth)) Then
            EndMonth = CurCol - 1
            .Range(.Cells(1, StartMonth), .Cells(1, EndMonth)).MergeCells = True
            .Cells(1, StartMonth) = .Cells(2, StartMonth)
            StartMonth = CurCol
        End If
    Loop Until CurCol = 41 'Ends at AQ!
End With
End Sub

All you would need to do is format the Row to display Centered and only show Month and Year.

And for the Conditional Formula, you are correct, I used Column A in my working example which you don't do.
If you need my example worksheet just tell.

[MartinLiss]

The Feb 29th problem occurred because I put 1/31/2011 in cell B2 rather than 1/31/2012.

[MartinLiss]

...
If you need my example worksheet just tell.

Yes please if it will work in Excel 2002.

[opus]

Give me a couple of minutes, I found some mistakes in the code (me bad) and what is worth the VBA code is deleting my conditional formating. Stand By

[MartinLiss]

Give me a couple of minutes, I found some mistakes in the code (me bad) and what is worth the VBA code is deleting my conditional formating. Stand By

I was about to mention some problems. In case they aren't the same ones…

1. It doesn't request a start date so it assumes 1/15/1900 for some reason and the date shows up as 'Jan-00'
2. The date for the next month assume 1/1/1900 and the cells for that month aren't merged
3. Only the 1st month is merged

[opus]

Yes, I saw those errors (I believe at least)

I now did all (keeping fingers crosssed) in a Macro

Public Sub UpDateCalender()
Application.DisplayAlerts = False
'Clear old Data and Format
With ThisWorkbook.ActiveSheet
    .Range("1:1").MergeCells = False
    .Range("1:1").Clear
    .Range("1:3").Borders(xlEdgeLeft).LineStyle = xlNone
    .Range("1:3").Borders(xlEdgeTop).LineStyle = xlNone
    .Range("1:3").Borders(xlEdgeBottom).LineStyle = xlNone
    .Range("1:3").Borders(xlInsideHorizontal).LineStyle = xlNone
    .Range("1:3").Borders(xlInsideVertical).LineStyle = xlNone
    .Range("1:3").Interior.TintAndShade = 0
    'Set actual Date in B2
    .Cells(2, 2) = Date
    'Do the new formatting and fill in new Data
    Dim CurCol As Integer
    Dim StartMonth As Integer 'First Column for this Month
    Dim EndMonth As Integer 'Last Column for this Month
    CurCol = 2
    With Range("B1:B3")
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeLeft).Weight = xlThin
    End With
    'find first and last Column for the month
    StartMonth = CurCol
    Do
        CurCol = CurCol + 1
        If Month(.Cells(2, CurCol)) <> Month(.Cells(2, StartMonth)) Or CurCol = 43 Then 'Last Column is 43=AQ!
            If CurCol = 43 And Not (Month(.Cells(2, CurCol)) <> Month(.Cells(2, StartMonth))) Then
                EndMonth = 43
            Else
                EndMonth = CurCol - 1
            End If
            If Not StartMonth = EndMonth Then
                .Range(.Cells(1, StartMonth), .Cells(1, EndMonth)).MergeCells = True
                .Cells(1, StartMonth) = .Cells(2, StartMonth)
            End If
            If CurCol = 43 And Not (Month(.Cells(2, CurCol)) <> Month(.Cells(2, StartMonth))) Then
                StartMonth = CurCol + 1
            Else
                StartMonth = CurCol
            End If
            .Range(.Cells(1, StartMonth), .Cells(3, StartMonth)).Borders(xlEdgeLeft).LineStyle = xlContinuous
            .Range(.Cells(1, StartMonth), .Cells(3, StartMonth)).Borders(xlEdgeLeft).Weight = xlThin
        End If
    Loop Until CurCol = 43
End With
Range("1:1").NumberFormat = " mmm-yy"
Range("1:1").HorizontalAlignment = xlCenter
With Range("B2:AQ2")
    .Borders(xlEdgeTop).LineStyle = xlContinuous
    .Borders(xlEdgeTop).Weight = xlThin
    .Borders(xlEdgeBottom).LineStyle = xlContinuous
    .Borders(xlEdgeBottom).Weight = xlThin
    .Interior.Pattern = xlSolid
    .Interior.ThemeColor = xlThemeColorDark1
    .Interior.TintAndShade = -0.249977111117893
End With
Application.DisplayAlerts = True
End Sub

You might want to change the actual color for Row 2!
If only the first or the last day is in a specific month, no Title will be shown!

[MartinLiss]

I selected the first two rows of my sheet, cleared them and then executed your code. I had to remove the lines 12, 56 and 57 because they gave me 'Object does not support this property or method' errors. After doing that it gave back essentailly two blank rows. How should I test it?

[opus]

Sorry for those three lines, I didn't expect them not to run in your Excel-Version. All they do is remove or set a color filing for Row2.
The macro should run on the current WorkSheet, which I assumed to formated in Row2 and Row3 as stated in your post #1.

I'll put my working-file into this reply.

Will close down for tonigth (it'S 11:30 PM in here) will look after that first thing tomorrow.

[MartinLiss]

Okay thanks I'll take a look at it.

Here is what your post #11 code gave me. And when I asked "how should I test it" I was asking if I need to anything on an old sheet before clicking the button?

[opus]

No action is needed besides having the Sheet with the correct ly formatted rows 2and 3 open, however I saw that I missed your Step 7(copy rows 1 to 3 to another Sheet). Sorry, that will have to wait until tommorrow.

[MartinLiss]

I realized that I was testing your code on a very old sheet that didn't have my current formatting and once I corrected that your code worked almost perfectly; thank you!

The problems I found were that
o It didn't ask for a starting date - I corrected that
o It removed the formatting (the gray color) in cells A1 and AR1 - I corrected that
o It doesn't do anything about 'narrow' months (like the one column for January
o It doesn't copy to sheet2

I'm going to work on those last two and see what I can do.

I've done very little Office coding previously and I'm wondering what the best way is to save code changes without saving the sheet?

[MartinLiss]

Okay I just can't figure out how to handle 'narrow' months.

Ideally I'd like the code to follow this pseudocode

If text of the month (like 'Jan-12') doesn't fit in the columns or column Then
    Change text to 'Jan'
    If that text still doesn't fit Then
        Change text to 'J'
    End If
End If

I'd settle however for always using the first letter of the month if the full text doesn't fit. Or if the 'doesn't fit' part is difficult to determine then if there are 3 or less columns involved the use the first letter.

Note that the too narrow situation could occur either with the first month or the last month.

Here's my current code on Sheet1:

Private Sub CommandButton1_Click()
Dim StrDate As String

StrDate = InputBox("Please enter starting date 'MM/DD/YYYY", "Chart Starting Date", Date)

Application.DisplayAlerts = False
'Clear old Data and Format
With ThisWorkbook.ActiveSheet
    .Range("1:1").MergeCells = False
    .Range("B1:AQ1").Clear
    .Range("1:3").Borders(xlEdgeLeft).LineStyle = xlNone
    .Range("1:3").Borders(xlEdgeTop).LineStyle = xlNone
    .Range("B1:AQ1").Borders(xlEdgeBottom).LineStyle = 1
    .Range("1:3").Borders(xlInsideHorizontal).LineStyle = xlNone
    .Range("1:3").Borders(xlInsideVertical).LineStyle = xlNone

    ' Put start date in B2
    .Cells(2, 2) = StrDate
    'Do the new formatting and fill in new Data
    Dim CurCol As Integer
    Dim StartMonth As Integer 'First Column for this Month
    Dim EndMonth As Integer 'Last Column for this Month
    CurCol = 2
    With Range("B1:B3")
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeLeft).Weight = xlThin
    End With
    'find first and last Column for the month
    StartMonth = CurCol
    Do
        CurCol = CurCol + 1
        If Month(.Cells(2, CurCol)) <> Month(.Cells(2, StartMonth)) Or CurCol = 43 Then 'Last Column is 43=AQ!
            If CurCol = 43 And Not (Month(.Cells(2, CurCol)) <> Month(.Cells(2, StartMonth))) Then
                EndMonth = 43
            Else
                EndMonth = CurCol - 1
            End If
            If Not StartMonth = EndMonth Then
                .Range(.Cells(1, StartMonth), .Cells(1, EndMonth)).MergeCells = True
                .Cells(1, StartMonth) = .Cells(2, StartMonth)
            End If
            If CurCol = 43 And Not (Month(.Cells(2, CurCol)) <> Month(.Cells(2, StartMonth))) Then
                StartMonth = CurCol + 1
            Else
                StartMonth = CurCol
            End If
            .Range(.Cells(1, StartMonth), .Cells(3, StartMonth)).Borders(xlEdgeLeft).LineStyle = xlContinuous
            .Range(.Cells(1, StartMonth), .Cells(3, StartMonth)).Borders(xlEdgeLeft).Weight = xlThin
        End If
    Loop Until CurCol = 43
End With
Range("1:1").NumberFormat = " mmm-yy"
Range("1:1").HorizontalAlignment = xlCenter
With Range("B2:AQ2")
    .Borders(xlEdgeTop).LineStyle = xlContinuous
    .Borders(xlEdgeTop).Weight = xlThin
    .Borders(xlEdgeBottom).LineStyle = xlContinuous
    .Borders(xlEdgeBottom).Weight = xlThin
    .Interior.Pattern = xlSolid
End With

' Copy rows 1 to 3 to sheet "Sheet2"
ThisWorkbook.ActiveSheet.Rows("1:3").Select
Selection.Copy
Sheets("Sheet2").Select
Sheets("Sheet2").Rows("1:3").Select
ActiveSheet.Paste
Sheets("Sheet1").Select

Application.CutCopyMode = False

Application.DisplayAlerts = True

End Sub

[opus]

Good Morning,

1.IMHO your code doesn't get the date correctly as a date, it uses just the String, I changed that.

2. Narrow Month will display either only the 3-Letter Month (2 Cells) or just the first Letter of the month (1 Cell).

3. You do the copy on the hardcoded SheetName "Sheet2", you need to make sure that such a Sheet always exists! The same is true for "Sheet1" to which you are jumping back.

I hope everything is fixed now.

Public Sub UpDateCalender()
Dim StrDate
StrDate = InputBox("Please enter starting date 'MM/DD/YYYY", "Chart Starting Date", Date)
Application.DisplayAlerts = False
'Clear old Data and Format
With ThisWorkbook.ActiveSheet
    .Range("1:1").MergeCells = False
    .Range("B1:AQ1").Clear
    .Range("B1:AQ1").NumberFormat = " mmm-yy"
    .Range("1:3").Borders(xlEdgeLeft).LineStyle = xlNone
    .Range("1:3").Borders(xlEdgeTop).LineStyle = xlNone
    .Range("1:3").Borders(xlEdgeBottom).LineStyle = xlNone
    .Range("1:3").Borders(xlInsideHorizontal).LineStyle = xlNone
    .Range("1:3").Borders(xlInsideVertical).LineStyle = xlNone
    'Set actual Date in B2
    .Cells(2, 2) = DateValue(StrDate)
    'Do the new formatting and fill in new Data
    Dim CurCol As Integer
    Dim StartMonth As Integer 'First Column for this Month
    Dim EndMonth As Integer 'Last Column for this Month
    CurCol = 2
    With Range("B1:B3")
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeLeft).Weight = xlThin
    End With
    'find first and last Column for the month
    StartMonth = CurCol
    Do
        CurCol = CurCol + 1
        If Month(.Cells(2, CurCol)) <> Month(.Cells(2, StartMonth)) Or CurCol = 43 Then 'Last Column is 43=AQ!
            If CurCol = 43 And Not (Month(.Cells(2, CurCol)) <> Month(.Cells(2, StartMonth))) Then
                EndMonth = 43
            Else
                EndMonth = CurCol - 1
            End If
            .Range(.Cells(1, StartMonth), .Cells(1, EndMonth)).MergeCells = True
            .Cells(1, StartMonth) = .Cells(2, StartMonth)
            If Abs(EndMonth - StartMonth) = 1 Then
                .Cells(1, StartMonth).FormulaR1C1 = "=LEFT(TEXT(R[1]C,""MMMM""),3)"
            ElseIf Abs(EndMonth - StartMonth) < 1 Then
                .Cells(1, StartMonth).FormulaR1C1 = "=LEFT(TEXT(R[1]C,""MMMM""),1)"
            End If
            If CurCol = 43 And Not (Month(.Cells(2, CurCol)) <> Month(.Cells(2, StartMonth))) Then
                StartMonth = CurCol + 1
            Else
                StartMonth = CurCol
            End If
            .Range(.Cells(1, StartMonth), .Cells(3, StartMonth)).Borders(xlEdgeLeft).LineStyle = xlContinuous
            .Range(.Cells(1, StartMonth), .Cells(3, StartMonth)).Borders(xlEdgeLeft).Weight = xlThin
        End If
    Loop Until CurCol = 43
    .Range("1:1").HorizontalAlignment = xlCenter
    .Range("B2:AQ2").Borders(xlEdgeTop).LineStyle = xlContinuous
    .Range("B2:AQ2").Borders(xlEdgeTop).Weight = xlThin
    .Range("B2:AQ2").Borders(xlEdgeBottom).LineStyle = xlContinuous
    .Range("B2:AQ2").Borders(xlEdgeBottom).Weight = xlThin
    ' Copy rows 1 to 3 to sheet "Sheet2"
    .Rows("1:3").Copy
    ThisWorkbook.Sheets("Sheet2").Select
    ThisWorkbook.Sheets("Sheet2").Rows("1:3").Select
    ActiveSheet.Paste
    ThisWorkbook.Sheets("Sheet1").Select
    Application.CutCopyMode = False
End With
Application.DisplayAlerts = True
End Sub

[MartinLiss]

Thanks for your help.

[Spoo]

Marty

I was beating my head against the wall with this
last night, and it looks like I'm too late .. Opus has
presented a solution and you've marked this RESOLVED.

Nonetheless, I finally got my alternate solution working
(mostly), and thought I'd include the pertinent code
snippet. The key feature is that it uses an array.

        ' 2.1. Put start date in B2
        .Cells(2, 2) = StrDate
        ' 2.2. Row 1 -- MMM-YY
        Dim pMon, cMon
        Dim aTXT(3, 4)
        ' aTXT(ee, 1) = beg col
        ' aTXT(ee, 2) = end col
        ' aTXT(ee, 3) = width
        ' aTXT(ee, 4) = raw text formatted mmm-yy
        ee = 1
        aTXT(1, 1) = 2
        pMon = Month(StrDate)
        ' 2.3. fill array
        For cc = 2 To 43
            cMon = Month(.Cells(2, cc))
            ' new month
            If cMon > pMon Then
                pMon = cMon
                ee = ee + 1
                aTXT(ee, 1) = cc
            End If
            ' update
            aTXT(ee, 2) = cc
            aTXT(ee, 3) = aTXT(ee, 2) - aTXT(ee, 1) + 1
            aTXT(ee, 4) = Format(.Cells(2, cc), "mmm-yy")
        Next cc
        ' 2.4. post
        For ii = 1 To 3
            bb = aTXT(ii, 1)
            ee = aTXT(ii, 2)
            wid = aTXT(ii, 3)
            raw = aTXT(ii, 4)
            ' truncate as req'd
            If wid = 1 Then
                txt = Left(raw, 1)
            ElseIf wid = 2 Then
                txt = Left(raw, 3)
            Else
                txt = raw
            End If
            ' post
            .Cells(1, bb).NumberFormat = "@"
            .Cells(1, bb) = txt
            .Range(.Cells(1, bb), .Cells(1, ee)).merge (across)
        Next ii

Some comments

1. Text manipulation .. if StrDate is ..
   
   • 1/31/2012 .. J .. Feb-12 .. Mar-12 ....... << 1 col wide at left
   • 1/30/2012 .. Jan .. Feb-12 .. Mar-12 .... << 2 cols wide at left
   • 2/19/2012 .. Feb-12 .. Mar-12 .. Apr .... << 2 cols wide at col 42
   • 2/20/2012 .. Feb-12 .. Mar-12 .. A ....... << 1 col wide at col 43
2. Merging and Lines
   
   • I got it to merge, but not centered
   • I did not deal with the lines

FWIW, you need to check more than the left side .. in
rare cases, you may end up with a width of only 1 or 2
at the right side as well. I emphasize that just in case
that situation was overlooked.

Hope that's useful.

Spoo

[MartinLiss]

Spoo I hope your head doesn't hurt to much Seriously, thanks for the effort but I'm going to stick with Opus' method. I mentioned a few posts back that the 'narrow month' problem could occur at either end of the chart but I didn't test the right side. It turns out that Opus' code works when there is two columns there but not when there's just one. Don't worry about that (either of you); I can handle it.

[opus]

It turns out that Opus' code works when there is two columns there but not when there's just one.

WHAT??
I didn'T notice that one, OK it will not do that on the rigth side (I checked only the left one).

Here my updated code:

Public Sub UpDateCalender()
Dim StrDate
StrDate = InputBox("Please enter starting date 'MM/DD/YYYY", "Chart Starting Date", Date)
Application.DisplayAlerts = False
'Clear old Data and Format
With ThisWorkbook.ActiveSheet
    .Range("1:1").MergeCells = False
    .Range("B1:AQ1").Clear
    .Range("B1:AQ1").NumberFormat = " mmm-yy"
    .Range("1:3").Borders(xlEdgeLeft).LineStyle = xlNone
    .Range("1:3").Borders(xlEdgeTop).LineStyle = xlNone
    .Range("1:3").Borders(xlEdgeBottom).LineStyle = xlNone
    .Range("1:3").Borders(xlInsideHorizontal).LineStyle = xlNone
    .Range("1:3").Borders(xlInsideVertical).LineStyle = xlNone
    'Set actual Date in B2
    .Cells(2, 2) = DateValue(StrDate)
    'Do the new formatting and fill in new Data
    Dim CurCol As Integer
    Dim StartMonth As Integer 'First Column for this Month
    Dim EndMonth As Integer 'Last Column for this Month
    CurCol = 2
    With Range("B1:B3")
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeLeft).Weight = xlThin
    End With
    'find first and last Column for the month
    StartMonth = CurCol
    Do
        CurCol = CurCol + 1
        If Month(.Cells(2, CurCol)) <> Month(.Cells(2, StartMonth)) Or CurCol = 43 Then 'Last Column is 43=AQ!
            If CurCol = 43 And Not (Month(.Cells(2, CurCol)) <> Month(.Cells(2, StartMonth))) Then
                EndMonth = 43
            Else
                EndMonth = CurCol - 1
            End If
            .Range(.Cells(1, StartMonth), .Cells(1, EndMonth)).MergeCells = True
            .Cells(1, StartMonth) = .Cells(2, StartMonth)
            If Abs(EndMonth - StartMonth) = 1 Then
                .Cells(1, StartMonth).FormulaR1C1 = "=LEFT(TEXT(R[1]C,""MMMM""),3)"
            ElseIf Abs(EndMonth - StartMonth) < 1 Then
                .Cells(1, StartMonth).FormulaR1C1 = "=LEFT(TEXT(R[1]C,""MMMM""),1)"
            End If
            If CurCol = 43 And Not (Month(.Cells(2, CurCol)) <> Month(.Cells(2, StartMonth))) Then
                StartMonth = CurCol + 1
            Else
                StartMonth = CurCol
                .Cells(1, StartMonth).FormulaR1C1 = "=LEFT(TEXT(R[1]C,""MMMM""),1)"
            End If
            .Range(.Cells(1, StartMonth), .Cells(3, StartMonth)).Borders(xlEdgeLeft).LineStyle = xlContinuous
            .Range(.Cells(1, StartMonth), .Cells(3, StartMonth)).Borders(xlEdgeLeft).Weight = xlThin
        End If
    Loop Until CurCol = 43
    .Range("1:1").HorizontalAlignment = xlCenter
    .Range("B2:AQ2").Borders(xlEdgeTop).LineStyle = xlContinuous
    .Range("B2:AQ2").Borders(xlEdgeTop).Weight = xlThin
    .Range("B2:AQ2").Borders(xlEdgeBottom).LineStyle = xlContinuous
    .Range("B2:AQ2").Borders(xlEdgeBottom).Weight = xlThin
    ' Copy rows 1 to 3 to sheet "Sheet2"
    .Rows("1:3").Copy
    ThisWorkbook.Sheets("Sheet2").Select
    ThisWorkbook.Sheets("Sheet2").Rows("1:3").Select
    ActiveSheet.Paste
    ThisWorkbook.Sheets("Sheet1").Select
    Application.CutCopyMode = False
End With
Application.DisplayAlerts = True
End Sub

[Spoo]

Opus

Way cool .. the VB.Net wrapper, that is.
It really pops the key words.

Spoo

[opus]

I hope that wasn't against "the rules".