[RESOLVED] Automate Some Cell Formatting in Excel 2002-VBForums
Results 1 to 24 of 24

Thread: [RESOLVED] Automate Some Cell Formatting in Excel 2002

  1. #1

    Thread Starter
    Former Admin/Moderator MartinLiss's Avatar
    Join Date
    Sep 1999
    Location
    San Jose, CA
    Posts
    32,878

    Resolved [RESOLVED] Automate Some Cell Formatting in Excel 2002

    I have a spreadsheet that contains two identical sheets with headings like this
    Name:  Microsoft Excel.jpg
Views: 60
Size:  38.9 KB

    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.
      Name:  Microsoft Excel-1.jpg
Views: 62
Size:  38.5 KB
    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
      Name:  Microsoft Excel-3.jpg
Views: 60
Size:  39.1 KB
    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.

  2. #2
    I don't do your homework! opus's Avatar
    Join Date
    Jun 2000
    Location
    Good Old Europe
    Posts
    3,863

    Re: Automate Some Cell Formatting in Excel 2002

    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
    Code:
    =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!
    You're welcome to rate this post!
    If your problem is solved, please use the Mark thread as resolved button


    Wait, I'm too old to hurry!

  3. #3

    Thread Starter
    Former Admin/Moderator MartinLiss's Avatar
    Join Date
    Sep 1999
    Location
    San Jose, CA
    Posts
    32,878

    Re: Automate Some Cell Formatting in Excel 2002

    Quote Originally Posted by opus View Post
    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
    Code:
    =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.

  4. #4
    PowerPoster
    Join Date
    Dec 2004
    Posts
    20,073

    Re: Automate Some Cell Formatting in Excel 2002

    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
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  5. #5

    Thread Starter
    Former Admin/Moderator MartinLiss's Avatar
    Join Date
    Sep 1999
    Location
    San Jose, CA
    Posts
    32,878

    Re: Automate Some Cell Formatting in Excel 2002

    Quote Originally Posted by westconn1 View Post
    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?

  6. #6
    I don't do your homework! opus's Avatar
    Join Date
    Jun 2000
    Location
    Good Old Europe
    Posts
    3,863

    Re: Automate Some Cell Formatting in Excel 2002

    I have a macro for doing your Row1 stuff

    Code:
    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.
    You're welcome to rate this post!
    If your problem is solved, please use the Mark thread as resolved button


    Wait, I'm too old to hurry!

  7. #7

    Thread Starter
    Former Admin/Moderator MartinLiss's Avatar
    Join Date
    Sep 1999
    Location
    San Jose, CA
    Posts
    32,878

    Re: Automate Some Cell Formatting in Excel 2002

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

  8. #8

    Thread Starter
    Former Admin/Moderator MartinLiss's Avatar
    Join Date
    Sep 1999
    Location
    San Jose, CA
    Posts
    32,878

    Re: Automate Some Cell Formatting in Excel 2002

    Quote Originally Posted by opus View Post
    ...
    If you need my example worksheet just tell.
    Yes please if it will work in Excel 2002.

  9. #9
    I don't do your homework! opus's Avatar
    Join Date
    Jun 2000
    Location
    Good Old Europe
    Posts
    3,863

    Re: Automate Some Cell Formatting in Excel 2002

    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
    You're welcome to rate this post!
    If your problem is solved, please use the Mark thread as resolved button


    Wait, I'm too old to hurry!

  10. #10

    Thread Starter
    Former Admin/Moderator MartinLiss's Avatar
    Join Date
    Sep 1999
    Location
    San Jose, CA
    Posts
    32,878

    Re: Automate Some Cell Formatting in Excel 2002

    Quote Originally Posted by opus View Post
    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

  11. #11
    I don't do your homework! opus's Avatar
    Join Date
    Jun 2000
    Location
    Good Old Europe
    Posts
    3,863

    Re: Automate Some Cell Formatting in Excel 2002

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

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

    vb Code:
    1. Public Sub UpDateCalender()
    2. Application.DisplayAlerts = False
    3. 'Clear old Data and Format
    4. With ThisWorkbook.ActiveSheet
    5.     .Range("1:1").MergeCells = False
    6.     .Range("1:1").Clear
    7.     .Range("1:3").Borders(xlEdgeLeft).LineStyle = xlNone
    8.     .Range("1:3").Borders(xlEdgeTop).LineStyle = xlNone
    9.     .Range("1:3").Borders(xlEdgeBottom).LineStyle = xlNone
    10.     .Range("1:3").Borders(xlInsideHorizontal).LineStyle = xlNone
    11.     .Range("1:3").Borders(xlInsideVertical).LineStyle = xlNone
    12.     .Range("1:3").Interior.TintAndShade = 0
    13.     'Set actual Date in B2
    14.     .Cells(2, 2) = Date
    15.     'Do the new formatting and fill in new Data
    16.     Dim CurCol As Integer
    17.     Dim StartMonth As Integer 'First Column for this Month
    18.     Dim EndMonth As Integer 'Last Column for this Month
    19.     CurCol = 2
    20.     With Range("B1:B3")
    21.         .Borders(xlEdgeLeft).LineStyle = xlContinuous
    22.         .Borders(xlEdgeLeft).Weight = xlThin
    23.     End With
    24.     'find first and last Column for the month
    25.     StartMonth = CurCol
    26.     Do
    27.         CurCol = CurCol + 1
    28.         If Month(.Cells(2, CurCol)) <> Month(.Cells(2, StartMonth)) Or CurCol = 43 Then 'Last Column is 43=AQ!
    29.             If CurCol = 43 And Not (Month(.Cells(2, CurCol)) <> Month(.Cells(2, StartMonth))) Then
    30.                 EndMonth = 43
    31.             Else
    32.                 EndMonth = CurCol - 1
    33.             End If
    34.             If Not StartMonth = EndMonth Then
    35.                 .Range(.Cells(1, StartMonth), .Cells(1, EndMonth)).MergeCells = True
    36.                 .Cells(1, StartMonth) = .Cells(2, StartMonth)
    37.             End If
    38.             If CurCol = 43 And Not (Month(.Cells(2, CurCol)) <> Month(.Cells(2, StartMonth))) Then
    39.                 StartMonth = CurCol + 1
    40.             Else
    41.                 StartMonth = CurCol
    42.             End If
    43.             .Range(.Cells(1, StartMonth), .Cells(3, StartMonth)).Borders(xlEdgeLeft).LineStyle = xlContinuous
    44.             .Range(.Cells(1, StartMonth), .Cells(3, StartMonth)).Borders(xlEdgeLeft).Weight = xlThin
    45.         End If
    46.     Loop Until CurCol = 43
    47. End With
    48. Range("1:1").NumberFormat = " mmm-yy"
    49. Range("1:1").HorizontalAlignment = xlCenter
    50. With Range("B2:AQ2")
    51.     .Borders(xlEdgeTop).LineStyle = xlContinuous
    52.     .Borders(xlEdgeTop).Weight = xlThin
    53.     .Borders(xlEdgeBottom).LineStyle = xlContinuous
    54.     .Borders(xlEdgeBottom).Weight = xlThin
    55.     .Interior.Pattern = xlSolid
    56.     .Interior.ThemeColor = xlThemeColorDark1
    57.     .Interior.TintAndShade = -0.249977111117893
    58. End With
    59. Application.DisplayAlerts = True
    60. 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!
    You're welcome to rate this post!
    If your problem is solved, please use the Mark thread as resolved button


    Wait, I'm too old to hurry!

  12. #12

    Thread Starter
    Former Admin/Moderator MartinLiss's Avatar
    Join Date
    Sep 1999
    Location
    San Jose, CA
    Posts
    32,878

    Re: Automate Some Cell Formatting in Excel 2002

    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?

  13. #13
    I don't do your homework! opus's Avatar
    Join Date
    Jun 2000
    Location
    Good Old Europe
    Posts
    3,863

    Re: Automate Some Cell Formatting in Excel 2002

    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.
    Attached Files Attached Files
    You're welcome to rate this post!
    If your problem is solved, please use the Mark thread as resolved button


    Wait, I'm too old to hurry!

  14. #14

    Thread Starter
    Former Admin/Moderator MartinLiss's Avatar
    Join Date
    Sep 1999
    Location
    San Jose, CA
    Posts
    32,878

    Re: Automate Some Cell Formatting in Excel 2002

    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?
    Attached Images Attached Images  

  15. #15
    I don't do your homework! opus's Avatar
    Join Date
    Jun 2000
    Location
    Good Old Europe
    Posts
    3,863

    Re: Automate Some Cell Formatting in Excel 2002

    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.
    You're welcome to rate this post!
    If your problem is solved, please use the Mark thread as resolved button


    Wait, I'm too old to hurry!

  16. #16

    Thread Starter
    Former Admin/Moderator MartinLiss's Avatar
    Join Date
    Sep 1999
    Location
    San Jose, CA
    Posts
    32,878

    Re: Automate Some Cell Formatting in Excel 2002

    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?

  17. #17

    Thread Starter
    Former Admin/Moderator MartinLiss's Avatar
    Join Date
    Sep 1999
    Location
    San Jose, CA
    Posts
    32,878

    Re: Automate Some Cell Formatting in Excel 2002

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

    Ideally I'd like the code to follow this pseudocode

    Code:
    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:
    Code:
    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

  18. #18
    I don't do your homework! opus's Avatar
    Join Date
    Jun 2000
    Location
    Good Old Europe
    Posts
    3,863

    Re: Automate Some Cell Formatting in Excel 2002

    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.

    VBA Code:
    1. Public Sub UpDateCalender()
    2. Dim StrDate
    3. StrDate = InputBox("Please enter starting date 'MM/DD/YYYY", "Chart Starting Date", Date)
    4. Application.DisplayAlerts = False
    5. 'Clear old Data and Format
    6. With ThisWorkbook.ActiveSheet
    7.     .Range("1:1").MergeCells = False
    8.     .Range("B1:AQ1").Clear
    9.     .Range("B1:AQ1").NumberFormat = " mmm-yy"
    10.     .Range("1:3").Borders(xlEdgeLeft).LineStyle = xlNone
    11.     .Range("1:3").Borders(xlEdgeTop).LineStyle = xlNone
    12.     .Range("1:3").Borders(xlEdgeBottom).LineStyle = xlNone
    13.     .Range("1:3").Borders(xlInsideHorizontal).LineStyle = xlNone
    14.     .Range("1:3").Borders(xlInsideVertical).LineStyle = xlNone
    15.     'Set actual Date in B2
    16.     .Cells(2, 2) = DateValue(StrDate)
    17.     'Do the new formatting and fill in new Data
    18.     Dim CurCol As Integer
    19.     Dim StartMonth As Integer 'First Column for this Month
    20.     Dim EndMonth As Integer 'Last Column for this Month
    21.     CurCol = 2
    22.     With Range("B1:B3")
    23.         .Borders(xlEdgeLeft).LineStyle = xlContinuous
    24.         .Borders(xlEdgeLeft).Weight = xlThin
    25.     End With
    26.     'find first and last Column for the month
    27.     StartMonth = CurCol
    28.     Do
    29.         CurCol = CurCol + 1
    30.         If Month(.Cells(2, CurCol)) <> Month(.Cells(2, StartMonth)) Or CurCol = 43 Then 'Last Column is 43=AQ!
    31.             If CurCol = 43 And Not (Month(.Cells(2, CurCol)) <> Month(.Cells(2, StartMonth))) Then
    32.                 EndMonth = 43
    33.             Else
    34.                 EndMonth = CurCol - 1
    35.             End If
    36.             .Range(.Cells(1, StartMonth), .Cells(1, EndMonth)).MergeCells = True
    37.             .Cells(1, StartMonth) = .Cells(2, StartMonth)
    38.             If Abs(EndMonth - StartMonth) = 1 Then
    39.                 .Cells(1, StartMonth).FormulaR1C1 = "=LEFT(TEXT(R[1]C,""MMMM""),3)"
    40.             ElseIf Abs(EndMonth - StartMonth) < 1 Then
    41.                 .Cells(1, StartMonth).FormulaR1C1 = "=LEFT(TEXT(R[1]C,""MMMM""),1)"
    42.             End If
    43.             If CurCol = 43 And Not (Month(.Cells(2, CurCol)) <> Month(.Cells(2, StartMonth))) Then
    44.                 StartMonth = CurCol + 1
    45.             Else
    46.                 StartMonth = CurCol
    47.             End If
    48.             .Range(.Cells(1, StartMonth), .Cells(3, StartMonth)).Borders(xlEdgeLeft).LineStyle = xlContinuous
    49.             .Range(.Cells(1, StartMonth), .Cells(3, StartMonth)).Borders(xlEdgeLeft).Weight = xlThin
    50.         End If
    51.     Loop Until CurCol = 43
    52.     .Range("1:1").HorizontalAlignment = xlCenter
    53.     .Range("B2:AQ2").Borders(xlEdgeTop).LineStyle = xlContinuous
    54.     .Range("B2:AQ2").Borders(xlEdgeTop).Weight = xlThin
    55.     .Range("B2:AQ2").Borders(xlEdgeBottom).LineStyle = xlContinuous
    56.     .Range("B2:AQ2").Borders(xlEdgeBottom).Weight = xlThin
    57.     ' Copy rows 1 to 3 to sheet "Sheet2"
    58.     .Rows("1:3").Copy
    59.     ThisWorkbook.Sheets("Sheet2").Select
    60.     ThisWorkbook.Sheets("Sheet2").Rows("1:3").Select
    61.     ActiveSheet.Paste
    62.     ThisWorkbook.Sheets("Sheet1").Select
    63.     Application.CutCopyMode = False
    64. End With
    65. Application.DisplayAlerts = True
    66. End Sub
    You're welcome to rate this post!
    If your problem is solved, please use the Mark thread as resolved button


    Wait, I'm too old to hurry!

  19. #19

  20. #20
    PowerPoster Spoo's Avatar
    Join Date
    Nov 2008
    Location
    Right Coast
    Posts
    2,656

    Re: [RESOLVED] Automate Some Cell Formatting in Excel 2002

    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.

    Code:
            ' 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
    Last edited by Spoo; Feb 2nd, 2012 at 10:12 AM.

  21. #21

    Thread Starter
    Former Admin/Moderator MartinLiss's Avatar
    Join Date
    Sep 1999
    Location
    San Jose, CA
    Posts
    32,878

    Re: [RESOLVED] Automate Some Cell Formatting in Excel 2002

    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.

  22. #22
    I don't do your homework! opus's Avatar
    Join Date
    Jun 2000
    Location
    Good Old Europe
    Posts
    3,863

    Re: [RESOLVED] Automate Some Cell Formatting in Excel 2002

    Quote Originally Posted by MartinLiss View Post
    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:

    VB.net Code:
    1. Public Sub UpDateCalender()
    2. Dim StrDate
    3. StrDate = InputBox("Please enter starting date 'MM/DD/YYYY", "Chart Starting Date", Date)
    4. Application.DisplayAlerts = False
    5. 'Clear old Data and Format
    6. With ThisWorkbook.ActiveSheet
    7.     .Range("1:1").MergeCells = False
    8.     .Range("B1:AQ1").Clear
    9.     .Range("B1:AQ1").NumberFormat = " mmm-yy"
    10.     .Range("1:3").Borders(xlEdgeLeft).LineStyle = xlNone
    11.     .Range("1:3").Borders(xlEdgeTop).LineStyle = xlNone
    12.     .Range("1:3").Borders(xlEdgeBottom).LineStyle = xlNone
    13.     .Range("1:3").Borders(xlInsideHorizontal).LineStyle = xlNone
    14.     .Range("1:3").Borders(xlInsideVertical).LineStyle = xlNone
    15.     'Set actual Date in B2
    16.     .Cells(2, 2) = DateValue(StrDate)
    17.     'Do the new formatting and fill in new Data
    18.     Dim CurCol As Integer
    19.     Dim StartMonth As Integer 'First Column for this Month
    20.     Dim EndMonth As Integer 'Last Column for this Month
    21.     CurCol = 2
    22.     With Range("B1:B3")
    23.         .Borders(xlEdgeLeft).LineStyle = xlContinuous
    24.         .Borders(xlEdgeLeft).Weight = xlThin
    25.     End With
    26.     'find first and last Column for the month
    27.     StartMonth = CurCol
    28.     Do
    29.         CurCol = CurCol + 1
    30.         If Month(.Cells(2, CurCol)) <> Month(.Cells(2, StartMonth)) Or CurCol = 43 Then 'Last Column is 43=AQ!
    31.             If CurCol = 43 And Not (Month(.Cells(2, CurCol)) <> Month(.Cells(2, StartMonth))) Then
    32.                 EndMonth = 43
    33.             Else
    34.                 EndMonth = CurCol - 1
    35.             End If
    36.             .Range(.Cells(1, StartMonth), .Cells(1, EndMonth)).MergeCells = True
    37.             .Cells(1, StartMonth) = .Cells(2, StartMonth)
    38.             If Abs(EndMonth - StartMonth) = 1 Then
    39.                 .Cells(1, StartMonth).FormulaR1C1 = "=LEFT(TEXT(R[1]C,""MMMM""),3)"
    40.             ElseIf Abs(EndMonth - StartMonth) < 1 Then
    41.                 .Cells(1, StartMonth).FormulaR1C1 = "=LEFT(TEXT(R[1]C,""MMMM""),1)"
    42.             End If
    43.             If CurCol = 43 And Not (Month(.Cells(2, CurCol)) <> Month(.Cells(2, StartMonth))) Then
    44.                 StartMonth = CurCol + 1
    45.             Else
    46.                 StartMonth = CurCol
    47.                 .Cells(1, StartMonth).FormulaR1C1 = "=LEFT(TEXT(R[1]C,""MMMM""),1)"
    48.             End If
    49.             .Range(.Cells(1, StartMonth), .Cells(3, StartMonth)).Borders(xlEdgeLeft).LineStyle = xlContinuous
    50.             .Range(.Cells(1, StartMonth), .Cells(3, StartMonth)).Borders(xlEdgeLeft).Weight = xlThin
    51.         End If
    52.     Loop Until CurCol = 43
    53.     .Range("1:1").HorizontalAlignment = xlCenter
    54.     .Range("B2:AQ2").Borders(xlEdgeTop).LineStyle = xlContinuous
    55.     .Range("B2:AQ2").Borders(xlEdgeTop).Weight = xlThin
    56.     .Range("B2:AQ2").Borders(xlEdgeBottom).LineStyle = xlContinuous
    57.     .Range("B2:AQ2").Borders(xlEdgeBottom).Weight = xlThin
    58.     ' Copy rows 1 to 3 to sheet "Sheet2"
    59.     .Rows("1:3").Copy
    60.     ThisWorkbook.Sheets("Sheet2").Select
    61.     ThisWorkbook.Sheets("Sheet2").Rows("1:3").Select
    62.     ActiveSheet.Paste
    63.     ThisWorkbook.Sheets("Sheet1").Select
    64.     Application.CutCopyMode = False
    65. End With
    66. Application.DisplayAlerts = True
    67. End Sub
    You're welcome to rate this post!
    If your problem is solved, please use the Mark thread as resolved button


    Wait, I'm too old to hurry!

  23. #23
    PowerPoster Spoo's Avatar
    Join Date
    Nov 2008
    Location
    Right Coast
    Posts
    2,656

    Re: [RESOLVED] Automate Some Cell Formatting in Excel 2002

    Opus

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

    Spoo

  24. #24
    I don't do your homework! opus's Avatar
    Join Date
    Jun 2000
    Location
    Good Old Europe
    Posts
    3,863

    Re: [RESOLVED] Automate Some Cell Formatting in Excel 2002

    I hope that wasn't against "the rules".
    You're welcome to rate this post!
    If your problem is solved, please use the Mark thread as resolved button


    Wait, I'm too old to hurry!

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Featured


Click Here to Expand Forum to Full Width

Survey posted by VBForums.