Automated Daily Production Report - Excel

[chadgaspard]

I am in need of a vba module that would allow me to do the following:

I currently have a workbook which is Titled "Aspen DPR 10-19". The "10-19" changes based off of current month-year. This Daily Production Report has a tab titled "Monthly Report" and also has a tab for each day of the month simply titled; "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16" "17", "18", "19", "20", "21", "22", "23", "24, "25", "26", "27", "28", "29", "30", "31", and the last tab is "1". "1" represents the 1st day of the upcoming month.

I need vba code for a Button named "Transfer to New Month", which I already have on worksheet "1", that would copy all tabs, open a new workbook, and paste all tabs into the new workbook, but add or take away tabs based off how many days are in that upcoming month. I also need it to rename the date in cell range C4:D4 to the second day of the upcoming month (e.g. 11/2/19).

I also need vba code for a button I already have on each sheet titled "Transfer Well Test" that would copy all data from the current active worksheet section (cell range A43 through N49) and paste this data into the exact spot on the rest of the numbered worksheets (not the sheet titled "Monthly Report"), but done so based off of the number of days (tabs) for the current month - and transfer that same data to next months report (all numbered tabs from Tab "2" to Tab "1".

Is this possible? If so this would save me hours of copy and pasting and minimize mistakes made by human error. Thanks in advance.

 

[Rijnsent]

Hi Chadgaspard,
what you describe sounds possible. Do you speak some VBA? This could be a great project to start learning it. To start: did you already try the macro recorder? Please post the code you recorded here, so people can help you modifying it to the functions you describe. Do post in CODE tags (see my signature).
Two free courses that are good starters: https://www.excel-pratique.com/en/vba.php and https://homeandlearn.org/
Cheers,
Koen

 

[chadgaspard]

I've been working on it yes. I can get it to perform the basics, but the variables is what's killing me.

Transfer_Well_Test Macro:

[COLOR=#222222][FONT=Verdana][FONT=Verdana]Sub Transfer_Well_Test()
'
' Transfer_Well_Test Macro
'[/FONT][/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana][FONT=Verdana]'
    Range("A43:N49").Select
    Selection.Copy
    Sheets("3").Select
    Range("A43:N49").Select
    ActiveSheet.Paste
    Sheets("4").Select
    Range("A43:N49").Select
    ActiveSheet.Paste
    Sheets("5").Select
    Range("A43:N49").Select
    ActiveSheet.Paste
    Sheets("6").Select
    Range("A43:N49").Select
    ActiveSheet.Paste
    Sheets("7").Select
    Range("A43:N49").Select
    ActiveSheet.Paste
    Sheets("8").Select
    Range("A43:N49").Select
    ActiveSheet.Paste
    Sheets("9").Select
    Range("A43:N49").Select
    ActiveSheet.Paste
    Sheets("10").Select
    Range("A43:N49").Select
    ActiveSheet.Paste
    Sheets("11").Select
    Range("A43:N49").Select
    ActiveSheet.Paste
    Sheets("12").Select
    Range("A43:N49").Select
    ActiveSheet.Paste
    Sheets("13").Select
    Range("A43:N49").Select
    ActiveSheet.Paste
    Sheets("14").Select
    Range("A43:N49").Select
    ActiveSheet.Paste
    Sheets("15").Select
    Range("A43:N49").Select
    ActiveSheet.Paste
    Sheets("16").Select
    Range("A43:N49").Select
    ActiveSheet.Paste
    Sheets("17").Select
    Range("A43:N49").Select
    ActiveSheet.Paste
    Sheets("18").Select
    Range("A43:N49").Select
    ActiveSheet.Paste
    Sheets("19").Select
    Range("A43:N49").Select
    ActiveSheet.Paste
    Sheets("20").Select
    Range("A43:N49").Select
    ActiveSheet.Paste
    Sheets("21").Select
    Range("A43:N49").Select
    ActiveSheet.Paste
    Sheets("22").Select
    Range("A43:N49").Select
    ActiveSheet.Paste
    Sheets("23").Select
    Range("A43:N49").Select
    ActiveSheet.Paste
    Sheets("24").Select
    Range("A43:N49").Select
    ActiveSheet.Paste
    Sheets("25").Select
    Range("A43:N49").Select
    ActiveSheet.Paste
    Sheets("26").Select
    Range("A43:N49").Select
    ActiveSheet.Paste
    Sheets("27").Select
    Range("A43:N49").Select
    ActiveSheet.Paste
    Sheets("28").Select
    Range("A43:N49").Select
    ActiveSheet.Paste
    Sheets("29").Select
    Range("A43:N49").Select
    ActiveSheet.Paste
    Sheets("30").Select
    Range("A43:N49").Select
    ActiveSheet.Paste
    Sheets("1").Select
    Range("A43:N49").Select
    ActiveSheet.Paste
    ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
    Sheets("2").Select
End Sub

The code above was captured by recording a macro and works beautifully, however it lacks the ability to 1) Add or subtract days (sheets) based off of numbers of days in the current month. In other words, whenever a sheet is added or taken away (manually or otherwise) it does not adjust the number of sheets it pastes the data to; 2) It lacks the ability to paste into the new workbook (all numbered sheets) for the upcoming month.; and 3) takes 15 seconds or so to complete it's steps once the button is clicked.

Transfer_to_new_month:

[FONT=Verdana]Sub Transfer_to_new_month()
'
' Transfer_to_new_month Macro
'[/FONT]
[FONT=Verdana]'
    Sheets(Array("Monthly Report", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", _
        "13", "14", "15", "16", "17", "18", "19", "20", "21", "22", "23", "24", "1")).Select
    Sheets("1").Activate
    Sheets(Array("25", "26", "27", "28", "29", "30")).Select Replace:=False
    Sheets(Array("Monthly Report", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", _
        "13", "14", "15", "16", "17", "18", "19", "20", "21", "22", "23", "24", "1")).Select
    Sheets("1").Activate
    Sheets(Array("25", "26", "27", "28", "29", "30")).Select Replace:=False
    Sheets(Array("Monthly Report", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", _
        "13", "14", "15", "16", "17", "18", "19", "20", "21", "22", "23", "24", "25", "26", "27", "28" _
        , "29", "30", "1")).Copy
    Sheets("2").Select
    Range("C4:D4").Select
    ActiveCell.FormulaR1C1 = "='1'!R[2]C[16]"
    Range("C5:D5").Select
    ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
    Sheets("Monthly Report").Select
    Range("B10").Select
    ActiveCell.FormulaR1C1 = "='2'!R[-6]C[1]:R[-6]C[2]"
    Range("B11").Select
    Sheets("2").Select
    
End Sub

This one needs some work. Currently it: 1) Copies all sheets in the current daily report, 2) Opens a new workbook and pastes all of the sheets into the new workbook, changes the date on sheet "2" and changes the "Report Date" to the correct start date for the upcoming month - it gets this date from a cell on sheet "1" which was entered before the macro was initiated.

What it does not do: 1) Add or take away sheets based of the number of days in the upcoming month. 2) Save to the format "Aspen_DPR_mm-yy" based off of the name and year of the upcoming month.
[/FONT]


[/FONT][/FONT][/COLOR]​

 

[Fluff]

Cross posted https://www.excelforum.com/excel-programming-vba-macros/1294452-next-months-report.html

While we do not prohibit Cross-Posting on this site, we do ask that you please mention you are doing so and provide links in each of the threads pointing to the other thread (see rule 13 here along with the explanation: Forum Rules).
This way, other members can see what has already been done in regards to a question, and do not waste time working on a question that may already be answered.

If you have posted this question on any other sites, please supply the link(s)

 

[MoshiM]

For your first request:

This will copy the entire worksheet. You didn't specify if you wanted the date changed on all sheets so I will only change it for worksheet "2" as you have done.

Sub Month_Stuff()


Dim Days_Next_Month, Start_Date As Date, X As Long, WS1 As Worksheet, New_WB As Workbook, FileN As String, ERR_WS As Worksheet


Start_Date = DateSerial(Year(Date), Month(Date) + 1, 1) 'first day of next month


Days_Next_Month = 1


Do Until Start_Date = DateSerial(Year(Date), Month(Date) + 2, 1) - 1
    
    Start_Date = Start_Date + 1
    
    Days_Next_Month = Days_Next_Month + 1
    
Loop


Set New_WB = Workbooks.Add


Set WS1 = New_WB.Worksheets(1)


Application.EnableEvents = False


On Error Resume Next


For X = 1 To Days_Next_Month


    Set ERR_WS = ThisWorkbook.Worksheets(CStr(X))
    
    If ERR.Number = 0 Then
        
        If X = 1 Then
            ERR_WS.Copy After:=WS1
        Else
            ERR_WS.Copy before:=WS1
        End If
        'new_wb.worksheets.add .name=cstr(x)
         'new_wb.worksheets(cstr(x)).range("[COLOR=#333333][FONT=Verdana]A43: N49[/FONT][/COLOR]") =Thisworkbook.worksheets(cstr(x)).range("[COLOR=#333333][FONT=Verdana]A43: N49[/FONT][/COLOR]") 
    Else
        
        With New_WB.Worksheets.Add
            .Move before:=WS1
            .Name = CStr(X)
        End With
        
        ERR.Clear
        
    End If


Next X


With Application


    .EnableEvents = True
    
    .DisplayAlerts = False
            WS1.Delete
    .DisplayAlerts = True
    
End With


New_WB.Worksheets("2").Range("C4:D4") = Start_Date + 2 'second day of the next month


FileN = ThisWorkbook.Path & "\" & "Aspen DPR " & Month(Start_Date) & "-" & Mid(Year(Start_Date), 3, 2) & ".xlsb"


New_WB.SaveAs Filename:=FileN, FileFormat:=xlExcel12


End Sub

 

[MoshiM]

Made a small error for the first request.

Sub Month_Stuff()


Dim Days_Next_Month, Start_Date As Date, X As Long, WS1 As Worksheet, New_WB As Workbook, FileN As String, ERR_WS As Worksheet


Start_Date = DateSerial(Year(Date), Month(Date) + 1, 1) 'first day of next month


Days_Next_Month = 1


Do Until Start_Date = DateSerial(Year(Date), Month(Date) + 2, 1) - 1 'loop until last day of next month
    
    Start_Date = Start_Date + 1
    
    Days_Next_Month = Days_Next_Month + 1
    
Loop


Set New_WB = Workbooks.Add


Set WS1 = New_WB.Worksheets(1)


Application.EnableEvents = False


On Error Resume Next


For X = 1 To Days_Next_Month


    Set ERR_WS = ThisWorkbook.Worksheets(CStr(X))
    
    If ERR.Number = 0 Then
        
        If X = 1 Then
            ERR_WS.Copy After:=WS1
        Else
            ERR_WS.Copy before:=WS1
        End If
               
    Else
        
        With New_WB.Worksheets.Add
            .Move before:=WS1
            .Name = CStr(X)
        End With
        
        ERR.Clear
        
    End If


Next X


With Application


    .EnableEvents = True
    
    .DisplayAlerts = False
            WS1.Delete
    .DisplayAlerts = True
    
End With


New_WB.Worksheets("2").Range("C4:D4") = DateSerial(Year(Start_Date), Month(Start_Date), 2) 'second day of the next month


FileN = ThisWorkbook.Path & "\" & "Aspen DPR " & Month(Start_Date) & "-" & Mid(Year(Start_Date), 3, 2) & ".xlsb"


New_WB.SaveAs Filename:=FileN, FileFormat:=xlExcel12


End Sub

 

[chadgaspard]

HUGE step in the right direction! Thank you MoshiM!! All I have to do now is figure out how to get it to copy the "Month_Stuff" Macro, "Transfer_Well_Test" Macro into the new workbook as well as the "Monthly Report" sheet and get it to change the date in the B10 Cell of the "Monthly Report" sheet to the first day of the upcoming month then I'll be set with this code!

 

[chadgaspard]

Tried to run it from November to create a December Report. It didn't create the extra sheet for December 31 or rename it to Apsen DPR 12-19. I'll keep trying to figure out what the missing pieces are. Thanks again for your help MoshiM!

 

[MoshiM]

Tried to run it from November to create a December Report. It didn't create the extra sheet for December 31 or rename it to Apsen DPR 12-19. I'll keep trying to figure out what the missing pieces are. Thanks again for your help MoshiM!

In what ways did you change the code to create a December Workbook?

It is set up to just create one for the next month based on the local time set on your computer.


Use the following and note that if you want to create a workbook for a month that isn't the next then comment out the blue line and edit the numbers in Green

Sub Month_Stuff()


Dim Days_Next_Month, Start_Date As Date, X As Long, WS1 As Worksheet, New_WB As Workbook, FileN As String, ERR_WS As Worksheet


[COLOR=#0000ff]Start_Date = DateSerial(Year(Date), Month(Date) + 1, 1) 'first day of Target month[/COLOR]
[COLOR=#0000ff]
[/COLOR]
[COLOR=#008000]'Start_Date = DateSerial(2019, 12, 1)[/COLOR][COLOR=#008000]'first day of Target month[/COLOR]


Days_Next_Month = 1


Do Until Start_Date = DateSerial(Year(Start_Date), Month(Start_Date) + 1, 1) - 1 'loop until last day of the target month
    
    Start_Date = Start_Date + 1
    
    Days_Next_Month = Days_Next_Month + 1
    
Loop


Set New_WB = Workbooks.Add


Set WS1 = New_WB.Worksheets(1)


Application.EnableEvents = False


On Error Resume Next


For X = 1 To Days_Next_Month


    Set ERR_WS = ThisWorkbook.Worksheets(CStr(X))
    
    If ERR.Number = 0 Then
        
        If X = 1 Then
            ERR_WS.Copy After:=WS1
        Else
            ERR_WS.Copy before:=WS1
        End If
               
    Else
        
        With New_WB.Worksheets.Add
            .Move before:=WS1
            .Name = CStr(X)
        End With
        
        ERR.Clear
        
    End If


Next X


With Application


    .EnableEvents = True
    
    .DisplayAlerts = False
            WS1.Delete
    .DisplayAlerts = True
    
End With


New_WB.Worksheets("2").Range("C4:D4") = DateSerial(Year(Start_Date), Month(Start_Date), 2) 'second day of the next month


FileN = ThisWorkbook.Path & "\" & "Aspen DPR " & Month(Start_Date) & "-" & Mid(Year(Start_Date), 3, 2) & ".xlsb"


New_WB.SaveAs Filename:=FileN, FileFormat:=xlExcel12


End Sub

 

[chadgaspard]

I didn't change anything in the code. I only changed the date to 12/2/19 in its cell on sheet "2". So that's great then if it utilizes the computer time/date.