Results 1 to 6 of 6

Thread: macro for new monthy worksheet ?

  1. #1

    macro for new monthy worksheet ?



    Register for a FREE account, and/
    or Log in to avoid these ads!

    Hi,

    I have a worksheet for monthly working schedule.I would like to create macro for a Cmdbutton, which would automatically jump on new sheet and add whole worksheet(table), with all formulas, so that copy/paste for new worksheet wouldn't be needed. Sheets should be named after next months.

    I have found some similar examples on forums, but usually they only create new sheet without tables. My table should also be needed to adjust It's cell length, according to number of days in month, which are ofcourse not allways same.

    Can this be done in VBA, Excel 2003 ?

  2. #2

  3. #3
    yes, thanks, that was my thread & now It's solved

  4. #4
    Acolyte patel's Avatar
    Join Date
    Feb 2014
    Location
    Italy
    Posts
    59
    Articles
    0
    instead of crossposting you could attach here the file with explanations

  5. #5
    Yes, sure, no problem, here It is :

    Code:
    Sub DoMonths()
        Dim J As Integer
        Dim K As Integer
        Dim sMo(12) As String
    
    
        sMo(1) = "January"
        sMo(2) = "February"
        sMo(3) = "March"
        sMo(4) = "April"
        sMo(5) = "May"
        sMo(6) = "June"
        sMo(7) = "July"
        sMo(8) = "August"
        sMo(9) = "September"
        sMo(10) = "October"
        sMo(11) = "November"
        sMo(12) = "December"
        
        Application.ScreenUpdating = False
        For J = 1 To 12
          Sheets(1).Copy after:=Sheets(Sheets.Count)
          With ActiveSheet
            .Name = sMo(J) & " " & Year(Date)
            For K = 1 To Day(DateSerial(Year(Date), J + 1, 0))
              .Cells(1, K).Value = DateSerial(Year(Date), J, K)
            Next K
            .Range(.Cells(1, K), .Cells(1, Columns.Count)).EntireColumn.Delete
            For K = .Shapes.Count To 1 Step -1
               If UCase(Left(.Shapes(K).Name, 3)) <> "OBJ" Then
                  .Shapes(K).Delete
               End If
            Next K
          End With
        Next J
        Application.ScreenUpdating = True
    
    
        Sheets(1).Activate
    End Sub
    This code for macro executes on CmdButton (or any desired shape) to add new sheets which are named by months in the year. It adds days in the months too (starting in A1 cell to the end of the row), for the current year. Existing sheets (normally sheet 1-3) are left intact. When new sheets, named after month are inserted all shapes are deleted (such as CmdButton). Code also deletes every columns after the end of days, correspoding to month !

    A few advice of changing code for your purposes :

    If you want all sheets to be automatically changed for month sequence (no sheets 1-3 left), insert into code - right after defining variables:

    Code:
    Sheets(1).Name = sMo(1)
    - you can do that also for sMo(2),sMo(3)...

    If you don't want to delete column after the end of days, simply delete or put comment (') on these commands :
    Code:
    .Range(.Cells(1, K), .Cells(1, Columns.Count)).EntireColumn.Delete
    If you have worksheet where your dates not start in A1, you can add this code and apply changes which fits your needs:

    Code:
     .Cells(2, 4 + K).Value = DateSerial(Year(Date), J, K)
    - this is example for Row 2, and Column 5 (E2 cell)


    If you want to delete only certain shapes (or buttons, activeX), change your code with name of object:

    Code:
    If UCase(Left(.Shapes(K).Name, 3)) <> "CMD" Then
    - This example deletes shapes with "CMD" name in it !

    And finally, If you want to clear contents of copied sheet in all new month sheets :
    Code:
    Sub ClearContents()
    Dim lngCounter As Long
    For lngCounter = 2 To 12
      Sheets(lngCounter).Range("B2:AE2").ClearContents                 - adjust your desired range and try It (haven't done It myself so far, I hope It works) 
    Next lngCounter
    End Sub

  6. #6
    Sorry, my mistake, If you want to change all existing sheets with months (sheet 1-3), you have to do this code, and then adjust It to your needs:

    Code:
    Sub DoMonths()
        Dim J As Integer
        Dim K As Integer
        Dim sMo(12) As String
    
    
        sMo(1) = "January"
        sMo(2) = "February"
        sMo(3) = "March"
        sMo(4) = "April"
        sMo(5) = "May"
        sMo(6) = "June"
        sMo(7) = "July"
        sMo(8) = "August"
        sMo(9) = "September"
        sMo(10) = "October"
        sMo(11) = "November"
        sMo(12) = "December"
        Sheets(1).Name = sMo(1)
        Application.DisplayAlerts = False
        For J = Sheets.Count To 2 Step -1
          Sheets(J).Delete
        Next
        Application.DisplayAlerts = True
        For J = 2 To 12
          Sheets(1).Copy after:=Sheets(Sheets.Count)
          Sheets(J).Name = sMo(J)
        Next
    
    
        Sheets(1).Activate
    End Sub
    Last edited by Lukael; 2014-02-25 at 09:07 PM.

Posting Permissions

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