Automatically add new sheet that updates information such as dates.

lockarde

Board Regular
Joined
Oct 23, 2016
Messages
77
Good afternoon all,

I have a workbook that has sheets for each month and tracks job requests, and the progress of said jobs. Every month, I copy the previous sheet, and update the sheet name to reflect the new month (format i.e "2.1 - 2.29", "3.1 - 3.31"). I've attached the XL2BB data for the information I'd like replicated, and updated depending on the month:
Daily Engineering Reporting.xlsm
ABCDEFGHIJKLMNOPQRST
1 Engineering Request DesignsTotal Engineering requests Sheet1: 2TOTAL WORKDAYS:22Completed Engineering requests Sheet1: 0/2
2Updated on: 2/28/20201:15 PM
3Item(s)LocationEmployeeJob IDCompany Job Value Net Price Est HoursAct HoursRequest DateComp DateLWHQty.StyleMil Spec?Prod Job?Concept?Design/BOM?
4Item 1
5Notes:Standard request, one note with basic job details. Job completed with no updates/change orders required. Completeion date gets filled in and counters at top track
6
7Item(s)LocationEmployeeJob IDCompany Job Value Crate Price Est HoursAct HoursRequest DateComp DateLWHQty.Crate StyleMil Spec?Prod Job?Concept?Design/BOM?
8Item 1
9Notes:Initally starts as standard request
10Notes:As job progress, notes possibly added detailing communication with customer
11Notes:Last note on a job such as this states current "status" of job. i.e "Customer requested changes - conference call scheduled 3/2/20"
Sheet1
Cell Formulas
RangeFormula
F1F1="Total Engineering requests " & MID(CELL("filename",A1),FIND("]",CELL("filename",A1))+1,255) & ": "
I1I1= COUNTIF(A:A,A4)
M1M1=NETWORKDAYS(V8,EOMONTH(V8,0))
P1P1="Completed Engineering requests " & MID(CELL("filename",A1),FIND("]",CELL("filename",A1))+1,255) & ": "
T1T1=COUNT($K:$K)&"/"&I1
Cells with Conditional Formatting
CellConditionCell FormatStop If True
T1Expression=COUNT($K:$K)=$I$1textNO
T1Expression=COUNT($K:$K)<$I$1textNO


The columns are large to accomdate the "notes" text I added, so here is a screen shot of what it looks like regularly:
1582923352155.png


As you can see there are counters at the top of each sheet that show total job requests, and then a counter that tracks "completed" requests. This is done by checking for a date in the "completed" column. Ideally, I would like this feature to check for incomplete jobs, and copy over the job details into the new sheet, only if the job is still incomplete at the time the new sheet is created. I'm not sure what the best way to initiate this feature is - maybe a button that just lives in the upper corner of each sheet? This is a little beyond me, and any help is greatly appreciated - you guys are rock stars imo!

Note: The cell with "Updated on" is generated on each save, so that doesn't need to be included in this feature
 

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.
Hello!
The macro starts the creation of a new sheet, asks what is the next month last day number (the new sheet is named after your template). Then it copies the designated range A1:T6 along with data, formulas and formatting to a new sheet. (I did not understand by what signs to determine that the work was not completed.)
To make a button for it is impractical if you are not going to use it several times a day.

VBA Code:
Option Explicit

Sub NewMonth()
Application.ScreenUpdating = False
Dim mFormat1$, mFormat2$, msb$, msa$, msa2 As Byte
Dim nws As Worksheet, ms_new$

msb = ActiveSheet.Name
msa = Replace(msb, " ", ""): msa = Left(msa, InStr(msa, ".") - 1)
msa2 = CByte(msa): msa2 = msa2 + 1
mFormat1 = "1"
mFormat2 = Format(InputBox("enter the last month's day"), "0")

ms_new = CStr(msa2) & Chr(46) & mFormat1 & Chr(32) & Chr(45) & Chr(32) & CStr(msa2) & Chr(46) & mFormat2
Set nws = Sheets.Add(after:=Sheets(Sheets.Count)): nws.Name = ms_new

Sheets(msb).Range("A1:T6").Copy: Sheets(ms_new).Range("A1").PasteSpecial Paste:=8, Operation:=xlNone
Sheets(ms_new).Range("A1").PasteSpecial Paste:=-4104, Operation:=xlNone
[C2].Select
          
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Hello!
The macro starts the creation of a new sheet, asks what is the next month last day number (the new sheet is named after your template). Then it copies the designated range A1:T6 along with data, formulas and formatting to a new sheet. (I did not understand by what signs to determine that the work was not completed.)
To make a button for it is impractical if you are not going to use it several times a day.

VBA Code:
Option Explicit

Sub NewMonth()
Application.ScreenUpdating = False
Dim mFormat1$, mFormat2$, msb$, msa$, msa2 As Byte
Dim nws As Worksheet, ms_new$

msb = ActiveSheet.Name
msa = Replace(msb, " ", ""): msa = Left(msa, InStr(msa, ".") - 1)
msa2 = CByte(msa): msa2 = msa2 + 1
mFormat1 = "1"
mFormat2 = Format(InputBox("enter the last month's day"), "0")

ms_new = CStr(msa2) & Chr(46) & mFormat1 & Chr(32) & Chr(45) & Chr(32) & CStr(msa2) & Chr(46) & mFormat2
Set nws = Sheets.Add(after:=Sheets(Sheets.Count)): nws.Name = ms_new

Sheets(msb).Range("A1:T6").Copy: Sheets(ms_new).Range("A1").PasteSpecial Paste:=8, Operation:=xlNone
Sheets(ms_new).Range("A1").PasteSpecial Paste:=-4104, Operation:=xlNone
[C2].Select
         
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Thanks for your response LazyBug! This should definitely be enough to get me started, and I should be able to tweak it to accomplish exactly what I'm looking for. One thing though - where am I putting this code, and how to I initialize it? I copied it into ThisWorkbook, but when I run it in the developer window, I get "Run-time error '5': invalid procedure call or argument."
 
Upvote 0
Hello!
The macro starts the creation of a new sheet, asks what is the next month last day number (the new sheet is named after your template). Then it copies the designated range A1:T6 along with data, formulas and formatting to a new sheet. (I did not understand by what signs to determine that the work was not completed.)
To make a button for it is impractical if you are not going to use it several times a day.

VBA Code:
Option Explicit

Sub NewMonth()
Application.ScreenUpdating = False
Dim mFormat1$, mFormat2$, msb$, msa$, msa2 As Byte
Dim nws As Worksheet, ms_new$

msb = ActiveSheet.Name
msa = Replace(msb, " ", ""): msa = Left(msa, InStr(msa, ".") - 1)
msa2 = CByte(msa): msa2 = msa2 + 1
mFormat1 = "1"
mFormat2 = Format(InputBox("enter the last month's day"), "0")

ms_new = CStr(msa2) & Chr(46) & mFormat1 & Chr(32) & Chr(45) & Chr(32) & CStr(msa2) & Chr(46) & mFormat2
Set nws = Sheets.Add(after:=Sheets(Sheets.Count)): nws.Name = ms_new

Sheets(msb).Range("A1:T6").Copy: Sheets(ms_new).Range("A1").PasteSpecial Paste:=8, Operation:=xlNone
Sheets(ms_new).Range("A1").PasteSpecial Paste:=-4104, Operation:=xlNone
[C2].Select
         
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Thanks again for your help LazyBug. With some tweaks I was able to get it do exactly what I wanted (minus copying over jobs that are incomplete, but I'm working on that now). I have it activate on double click of a particular cell, my code is below in case you wanted to take a look (Adding Next Month Code):
VBA Code:
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
    Dim Rng As Range, i As Integer
      Application.ScreenUpdating = False
    Dim mFormat1$, mFormat2$, msb$, msa$, msa2 As Byte
    Dim nws As Worksheet, ms_new$
    Dim mos As Integer, curdate As Double, moscheck As Integer, yearcheck As Integer, mostart As String
    i = Range("S2").Value

''Jobs on hold code:
   If Not Intersect(Target, Range("A4:A100")) Is Nothing Then
      If Target.Value Like "Item *" Then
         Set Rng = Intersect(Range(Target, Target.End(xlDown)).EntireRow, Range("A:T"))
        
         If Target.Interior.Color = RGB(213, 59, 59) Then
            Rng.Interior.Color = xlNone
            Rng.Columns(1).Interior.Color = 14277081
            If i = 0 Then
            i = 0
            Else
            i = i - 1
            End If
            Range("S2").Value = i
         Else
            Rng.Interior.Color = RGB(213, 59, 59)
            i = i + 1
            Range("S2").Value = i
         End If
      End If
      Cancel = True
   End If

''Adding Next Month Code:
If Not Intersect(Target, Range("T1:T2")) Is Nothing Then
    'If Target.Value Like "Next Month" Then
        curdate = Date
        moscheck = Month(curdate)
        yearcheck = year(curdate)
        
        mostart = Date - Day(Date) + 1
        
        msb = ActiveSheet.Name
        msa = Replace(msb, " ", ""): msa = Left(msa, InStr(msa, ".") - 1)
        msa2 = CByte(msa): msa2 = msa2 + 1
        mFormat1 = "1"
        
        mos = DateSerial(yearcheck, moscheck + 1, 1) - DateSerial(yearcheck, moscheck, 1)
        
        mFormat2 = mos
        
        ms_new = CStr(msa2) & Chr(46) & mFormat1 & Chr(32) & Chr(45) & Chr(32) & CStr(msa2) & Chr(46) & mFormat2
        Set nws = Sheets.Add(after:=Sheets(Sheets.Count)): nws.Name = ms_new
        
        Sheets(msb).Range("A1:T6").Copy: Sheets(ms_new).Range("A1").PasteSpecial Paste:=8, Operation:=xlNone
        Sheets(ms_new).Range("A1").PasteSpecial Paste:=-4104, Operation:=xlNone
        [C2].Select
        With Sheets(ms_new)
            .Range("v8").Value = curdate
            .Range("B5:T6").ClearContents
            .Columns("V").Hidden = True
            ActiveWindow.FreezePanes = False
            .Range("U3").Select
            ActiveWindow.FreezePanes = True
        End With
        Application.CutCopyMode = False
        Application.ScreenUpdating = True
    'End If
    Cancel = True
End If
End Sub
 
Upvote 0

Forum statistics

Threads
1,214,594
Messages
6,120,436
Members
448,964
Latest member
Danni317

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top