Automated Daily Production Report - Excel

C

chadgaspard

New Member
Joined
Nov 4, 2018
Messages
14
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.
 

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes
Sort by date Sort by votes
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
 
Upvote 0
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:

Code: 
[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]​
 
Last edited by a moderator:
Upvote 0
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)
 
Upvote 0
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.

Code: 
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
 
Last edited:
Upvote 0
Made a small error for the first request.

Code: 
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
 
Last edited:
Upvote 0
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!
 
Upvote 0
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!
 
Upvote 0
chadgaspard said:
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!
Click to expand...

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
Code: 
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
 
Last edited:
Upvote 0
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.
 
Upvote 0
You must log in or register to reply here.

Similar threads

I
  • Solved
Create daily tabs for a whole month
2
Replies
15
Views
301
Joe4
Joe4
B
  • Question
Copying data from a year tab and pasting into month tabs
Replies
2
Views
166
B-radK
B
D
  • Question
Deleted a bunch of tabs and now my main sheet doesn't work.
Replies
5
Views
254
Joe4
Joe4
P
  • Question
Need VBA to automatically copy paste rows based on dates of current month.
2
Replies
11
Views
182
pk970
P
S
  • Question
VBA Challenge
Replies
2
Views
215
SnowyBry
S

Forum statistics

Threads
1,214,520
Messages
6,120,008
Members
448,935
Latest member
ijat

Share this page

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