Page 1 of 2 12 LastLast
Results 1 to 15 of 19
  1. #1
    Lounger
    Join Date
    Sep 2013
    Posts
    34
    Thanks
    16
    Thanked 0 Times in 0 Posts

    Create a new sheet with month name and year name with monthly calendar sheet

    I would like a macro that will run in a workbook to do the following:
    - To create a sheet with the names of each month (worksheet name to be "mmmm yyyy") of the year and inside the sheet to be the month calendar. The calendar month to be on one line ( D13:AH13) and in another line to be the name of the day (D14:AH14) . Like in exemple attached
    - Macro to copy the information from the previous month for every new month sheet , only the calendar to be updated .The info from range D15:AH150 can be clear.
    - Column on Saturdays, Sundays and Non-working days to be with. Interior.ColorIndex = 6
    - Non-working days are declared in sheet variables range A2: A11

    I hope I gave enough informations.
    Attached Files Attached Files

  2. #2
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts
    What is the purpose of the macro? is this macro going to be a one-time thing or multiple?

    I think a better way may be to set up a standard sheet with the day of month in row 14 (1-31) and have the month number and year in some cell in the sheet and calculate the values in row 15. I would then use conditional formatting to highlight the weekends and off-days. This would make the highlighting live.

    Then the macro just has to make 12 copies of the sheets, change the cell with the month number and year and change the sheet name.

    Steve

  3. #3
    Lounger
    Join Date
    Sep 2013
    Posts
    34
    Thanks
    16
    Thanked 0 Times in 0 Posts
    This macro will run multiple, when the month is end then i will start a new month with informations to copy the range from previous month.
    i belive it`s a good ideea with one sheet and then 12 copies but the copies have to be only the previous month, not month January for sheet June by exemple.

  4. #4
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts
    Then there seems to be little need for a macro. If you create the sheet I described with the month and year added and the conditional formatting. At the end of the month, you would only need to copy the worksheet, then change the month number(and year when going from Dec to Jan) and then (if desired) hide or blacken the columns with dates outside the month - (the coloring could also be done with cond formatting...)

    Steve

  5. #5
    Lounger
    Join Date
    Sep 2013
    Posts
    34
    Thanks
    16
    Thanked 0 Times in 0 Posts
    can be this macro created on worbook atached first time? copy the sheet january 2014 ,rename with next month february 2014 and ''update'' the calendar? somethomg like this.

  6. #6
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts
    What do you want to do with the dates that are not in the month [eg Feb 29-31]? Should the columns be deleted (and ones added if needed again for March] or left alone, Blackened out, what??

    Steve

  7. #7
    Lounger
    Join Date
    Sep 2013
    Posts
    34
    Thanks
    16
    Thanked 0 Times in 0 Posts
    Just to be hide !!

  8. #8
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts
    Check this out to see if meets your needs

    Code:
    Option Explicit
    Sub CreateNewSheet()
      Dim rHolidays As Range
      Dim wPrev As Worksheet
      Dim wNew As Worksheet
      Dim sNew As String
      Dim iMonth As Integer
      Dim iYear As Integer
      Dim i As Integer
      Dim dDateSer As Double
      Dim iColStart As Integer
      Dim iRowStart As Integer
      Dim iRowEnd As Integer
      Dim iColorIndex As Integer
      Dim iHoliday As Integer
      Dim rColor As Range
      
      'Set as appropriate
      iColorIndex = 6
      iColStart = 4 'Col D
      iRowStart = 14
      iRowEnd = 150
      Set rHolidays = Range("Variables!A1:A15")
      
      On Error GoTo ErrHandler
      Application.ScreenUpdating = False
    
      Set wPrev = ActiveSheet
      'Get Previous Date
      dDateSer = 0
      On Error Resume Next
      dDateSer = DateValue(Application.WorksheetFunction. _
        Substitute(wPrev.Name, " ", " 1, "))
      On Error GoTo ErrHandler
      ' check if Date is valid
      If dDateSer = 0 Then
        MsgBox "ActiveSheet Name of '" & wPrev.Name & "' is not" & _
          vbCrLf & "a valid month/Year combination"
        GoTo ExitHandler
      Else
        iYear = Year(dDateSer)
        iMonth = Month(dDateSer) + 1
        If iMonth = 13 Then
          iMonth = 1
          iYear = iYear + 1
        End If
      End If
      sNew = Format(DateSerial(iYear, iMonth, 1), "mmmm yyyy")
      'Check if sheet already created
      Set wNew = Nothing
      On Error Resume Next
      Set wNew = Worksheets(sNew)
      On Error GoTo ErrHandler
      If Not wNew Is Nothing Then
        MsgBox sNew & " has already been created"
        GoTo ExitHandler
      End If
        
      wPrev.Copy After:=wPrev
      Set wNew = ActiveSheet
      With wNew
        .Name = sNew
        For i = 1 To 31
          dDateSer = DateSerial(iYear, iMonth, i)
          'check if Holiday
          iHoliday = 0
          On Error Resume Next
          iHoliday = Application.WorksheetFunction.Match(dDateSer, rHolidays, 0)
          On Error GoTo ErrHandler
          .Cells(iRowStart - 1, iColStart - 1 + i) = dDateSer
          .Cells(iRowStart, iColStart - 1 + i) = dDateSer
          Set rColor = .Range(.Cells(iRowStart, iColStart - 1 + i), _
            .Cells(iRowEnd, iColStart - 1 + i))
          'Check if weekend or holiday
          If iHoliday <> 0 Or Weekday(dDateSer) = 1 Or Weekday(dDateSer) = 7 Then
            'color it
            rColor.Interior.ColorIndex = iColorIndex
          Else
            rColor.Interior.ColorIndex = xlNone
          End If
          'Hide / Unhide column based on date
          If Month(dDateSer) = iMonth Then
            rColor.EntireColumn.Hidden = False
          Else
            rColor.EntireColumn.Hidden = True
          End If
        Next i
      End With
      'Let you know it was done
      MsgBox "Worksheet '" & wNew.Name & "' created"
    
    ExitHandler:
        Application.ScreenUpdating = True
        Exit Sub
        
    ErrHandler:
        MsgBox Err.Description
        Resume ExitHandler
    End Sub
    I check to make sure the workseet name selected is a date name, and that the next month has not already been created.
    Steve

  9. The Following User Says Thank You to sdckapr For This Useful Post:

    afm1985 (2014-02-16)

  10. #9
    Lounger
    Join Date
    Sep 2013
    Posts
    34
    Thanks
    16
    Thanked 0 Times in 0 Posts
    VBA runs incredibly. I own you some beers!
    I have some improvements if it`s posible
    This worbook this wil run on multiple computers.
    Let assume that the calendar language differs by initial "sheet name". ( the sheet name is in french and the region and language format is english)
    It`s posible that the initial sheet to be set in the language from "region and language format"( intl.cpl) , and not to have the MsgBox "ActiveSheet Name of '" & wPrev.Name & "' is not" & _ vbCrLf & "a valid month/Year combination" ? the initial sheet is always january
    And something else.... the initial sheet (january ) will be protected, i would like a piece of vba that will unprotect at the begin and protect at the end. the password will be "1111"
    Thanks very much sdckapr for your time!

  11. #10
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,634
    Thanks
    115
    Thanked 649 Times in 592 Posts
    Well I'll post my version anyway if you should need it.

    Maud

    Code:
    Public Sub NewMonth()
    Application.ScreenUpdating = False
    On Error GoTo Errorhandler
    Dim rng As Range
    yr = Right(Worksheets(1).Name, 4)
    '--------------------------------
    'CREATE NEXT MONTH'S SHEET
        num = Worksheets.Count
        Worksheets(num - 1).Activate
        If Left(ActiveSheet.Name, 3) = "Dec" Then Exit Sub
        ActiveSheet.Copy Before:=Sheets(num)
        ActiveSheet.Name = MonthName(num) & " " & yr
        Set rng = Range(Cells(13, 4), Cells(150, 34))
        rng.EntireColumn.Hidden = False
        rng.Interior.Color = xlNone
        '----------------------------
        'BUILD CALENDAR
        StartDate = num & "/1/" & yr
        EndDate = CDate(StartDate)
        MonthNum = Day(DateSerial(Year(EndDate), Month(EndDate) + 1, 1) - 1)
        For I = 4 To MonthNum + 3
        Cells(13, I) = CDate(num & "/" & I - 3 & "/" & yr)
        Cells(14, I) = WorksheetFunction.Text(StartDate, "ddd")
        StartDate = CDate(StartDate) + 1
        Next I
        '-------------------------------
        'SET NUMBER OF COLUMS
        If MonthNum < 31 Then
            Range(Cells(13, MonthNum + 4), Cells(150, 34)).EntireColumn.Hidden = True
        End If
        '-------------------------------
        'HIGHLIGHT COLUMNS
        With Worksheets("variables")
        For I = 4 To MonthNum + 3
            If Cells(14, I) = "Sun" Or Cells(14, I) = "Sat" Then
                Range(Cells(14, I), Cells(150, I)).Interior.ColorIndex = 6
            Else: For J = 2 To 11
                      'd = num & "/" & Cells(13, I) & "/" & yr
                      If CDate(num & "/" & I - 3 & "/" & yr) = .Cells(J, 1) Then
                          Range(Cells(14, I), Cells(150, I)).Interior.ColorIndex = 6
                      End If
                  Next J
            End If
        Next I
        End With
    '----------------------------------
    Application.ScreenUpdating = True
    MsgBox ActiveSheet.Name & " has been created.": Exit Sub
    Errorhandler: MsgBox "Check that Sheet 1 has been set up correctly"
    End Sub
    Attached Files Attached Files

  12. The Following User Says Thank You to Maudibe For This Useful Post:

    afm1985 (2014-02-16)

  13. #11
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts
    I can get rid of the check on the sheet, but it doesn't matter if the first sheet is January, my impression was you are not always copying January, you are copying at the end of the month and need to determine what sheet to copy and what the next sheet is.

    If the date will not be considered valid in Excel (which would trigger the error on a foreign named month) then the month name will still have to be determined at runtime. I see several likely options:
    1) change the sheet names to mm-yyyy format
    2) Create some lookup table of month names
    3) Base it on the current month (assuming you run it at the end of the month)
    4) count sheets (as Maudibe does) to determine the month number (must know how many non-month sheets there are, the month sheets must start with a known sheet, and you can't add or delete sheets without editing the program


    (1) is the easiest and allows directly getting the next month and does not depend on the language
    (2) would involve some work, adding the months for all the languages, and could be used to get the next month (this assumes that all month in all the languages being used are unique. This will work for English and French, but not if (eg) German is included, so will depend on the languages needed). you could just have a list of the months being used and not worry about all months and all languages

    But with 3&4 even after figuring out the current month, it would still require some lookup to get the next month name for the sheet name, which would require know the language and the month names for that language.

    How do you propose working with the months, how many different languages will the code have to determine?

    Steve

  14. The Following User Says Thank You to sdckapr For This Useful Post:

    afm1985 (2014-02-16)

  15. #12
    Lounger
    Join Date
    Sep 2013
    Posts
    34
    Thanks
    16
    Thanked 0 Times in 0 Posts
    The only language are english and romanian...but it`s ok, i can handle with your code!!
    But if you are kind i would like a piece of vba that will unprotect the sheet at the begin and the protect it at the end. the password will be "1111"
    Thanks sdckapr ,Thanks Maudibe, you make my work easier!!

  16. #13
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts
    To unprotect the newly created worksheet
    wNew.Unprotect Password:="1111"

    To protect it again at the end:
    wNew.Protect Password:="1111"

    Steve

  17. The Following User Says Thank You to sdckapr For This Useful Post:

    afm1985 (2014-02-16)

  18. #14
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,634
    Thanks
    115
    Thanked 649 Times in 592 Posts
    If you want to have a protected cells copied, you will need to unprotect the sheet, run the code, then re-protect it again as sdckapr demonstrates. Something to be careful with this method is if the code fails to break mode before completed, your sheet is now left unprotected. A better way is to use the Protect method with the UserInterfaceOnly switch set to true. The worksheet will be created and locked but only the code can manipulate the locked cells. If the code fails the sheet will still remain locked. The first line in blue locks the first sheet (if not already protected) while the second blue line locks each successive sheet as they are created. This can easily be adapted to sdckapr's code as well.

    Maud

    Code:
    Public Sub NewMonth()
    Application.ScreenUpdating = False
    On Error GoTo Errorhandler
    Dim rng As Range
    yr = Right(Worksheets(1).Name, 4)
    '--------------------------------
    'CREATE NEXT MONTH'S SHEET
        num = Worksheets.Count
        Worksheets(num - 1).Activate
        ActiveSheet.Protect Password:="1111", UserInterfaceOnly:=True
        If Left(ActiveSheet.Name, 3) = "Dec" Then Exit Sub
        ActiveSheet.Copy Before:=Sheets(num)
        ActiveSheet.Name = MonthName(num) & " " & yr
        Set rng = Range(Cells(13, 4), Cells(150, 34))
        rng.EntireColumn.Hidden = False
        rng.Interior.Color = xlNone
        '----------------------------
        'BUILD CALENDAR
        StartDate = num & "/1/" & yr
        EndDate = CDate(StartDate)
        MonthNum = Day(DateSerial(Year(EndDate), Month(EndDate) + 1, 1) - 1)
        For i = 4 To MonthNum + 3
        Cells(13, i) = CDate(num & "/" & i - 3 & "/" & yr)
        Cells(14, i) = WorksheetFunction.Text(StartDate, "ddd")
        StartDate = CDate(StartDate) + 1
        Next i
        '-------------------------------
        'SET NUMBER OF COLUMNS
        If MonthNum < 31 Then
            Range(Cells(13, MonthNum + 4), Cells(150, 34)).EntireColumn.Hidden = True
        End If
        '-------------------------------
        'HIGHLIGHT COLUMNS
        With Worksheets("variables")
        For i = 4 To MonthNum + 3
            If Cells(14, i) = "Sun" Or Cells(14, i) = "Sat" Then
                Range(Cells(14, i), Cells(150, i)).Interior.ColorIndex = 6
            Else: For J = 2 To 11
                      'd = num & "/" & Cells(13, I) & "/" & yr
                      If CDate(num & "/" & i - 3 & "/" & yr) = .Cells(J, 1) Then
                          Range(Cells(14, i), Cells(150, i)).Interior.ColorIndex = 6
                      End If
                  Next J
            End If
        Next i
        End With
    '----------------------------------
    ActiveSheet.Protect Password:="1111", UserInterfaceOnly:=True
    Application.ScreenUpdating = True
    MsgBox ActiveSheet.Name & " has been created.": Exit Sub
    Errorhandler: MsgBox "Check that Sheet 1 has been set up correctly"
    End Sub
    Last edited by Maudibe; 2014-02-16 at 18:47.

  19. The Following User Says Thank You to Maudibe For This Useful Post:

    afm1985 (2014-02-17)

  20. #15
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts
    Something to be careful with this method is if the code fails to break mode before completed, your sheet is now left unprotected
    In my experience, one of the better ways to handle this (and any other things that need to be reset at the end of the code, like screenupdating) is to have a exit handling section that adds those lines of code into it, so that they are always run before the code is exited. The error handler routine can call the exit handling routine.

    Steve

Page 1 of 2 12 LastLast

Posting Permissions

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