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.

 

[MoshiM]

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.

These should take care of the rest of your requests

Sub Month_Stuff()


Dim Target_Month_Days, Target_Month_Day_1 As Date, X As Long, WS1 As Worksheet, New_WB As Workbook, _
FileN As String, ERR_WS As Worksheet, RRR As Range
 
Transfer_Well_Test RRR


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


'Target_Month_Day_1 = DateSerial(2019, 12, 1) 'first day of Target Month if needed


Target_Month_Days = DateSerial(Year(Target_Month_Day_1), Month(Target_Month_Day_1) + 1, 1) - Target_Month_Day_1
                    
                    'first day of (Target_Month_Day_1 + 1 MONTH) - Target_Month_Day_1 = number of days in Tareget Month
                    
Set New_WB = Workbooks.Add 'create new workbook and store object in a variable


Set WS1 = New_WB.Worksheets(1) 'first worksheet of the newly created workbook


Application.EnableEvents = False


On Error Resume Next


For X = 1 To Target_Month_Days 'loop 1 to the number of days found in the target month


    Set ERR_WS = ThisWorkbook.Worksheets(CStr(X)) 'this will generate an error if it doesn't exist
    
    If Err.Number = 0 Then 'if the worksheet exists then copy it to the new Workbook
        
        If X = 1 Then
            ERR_WS.Copy After:=WS1
        Else
            ERR_WS.Copy Before:=WS1
        End If
               
    Else 'If it doesn't exit then create it within the new workbook and rename it
        
        With New_WB.Worksheets.Add
            .Move Before:=WS1
            .Name = CStr(X)
            .Range(RRR.Address) = RRR
        End With
        
        Err.Clear 'clear the generated error
        
    End If


Next X


With New_WB


    ThisWorkbook.Worksheets("Monthly Report").Copy Before:=.Worksheets(1) 'Copy Monthly Report to new Worksheet
    
    .Worksheets("2").Range("C4:D4") = DateSerial(Year(Target_Month_Day_1), Month(Target_Month_Day_1), 2) 'second day of the next month


    .Worksheets("Monthly Report").Range("B10") = DateSerial(Year(Target_Month_Day_1), Month(Target_Month_Day_1), 1) 'First Day of upcoming Month
    
End With


With Application


    .EnableEvents = True
    
    .DisplayAlerts = False
            WS1.Delete
    .DisplayAlerts = True
    
End With
CopyModules thisworkbook,NEW_WB

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


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


End Sub

Read the comment for the below macro.

Sub Transfer_Well_Test(ByRef RR As Range)


'SAVE BEFORE USING THIS TO MAKE SURE IT DOES WHAT YOU WANT PROPERLY


Dim WS As Worksheet, RR As Range


Set RR = ActiveWorkbook.ActiveSheet.Range("A43:N43") 'store this range in a variable


For Each WS In ActiveWorkbook.Worksheets
    
    With WS
    
        If Not WS Is ActiveWorkbook.ActiveSheet And IsNumeric(.Name) Then
            
            If CLng(.Name) <= 31 Then .Range("A43:N43") = RR
            
        End If
    
    End With
    
Next


End Sub

This one will require that both the target and source workbook be open and that you feed Workbook objects representing them into the Sub. Any forms for classes won't be exported properly.
This will also require a reference to Microsoft Visual Basic for Application Extensibility

Sub CopyModules(wbSource As Workbook, wbTarget As Workbook)


   Dim vbcompSource As VBComponent, vbcompTarget As VBComponent
   Dim sText As String, nType As Long
   
   For Each vbcompSource In wbSource.VBProject.VBComponents
      nType = vbcompSource.Type
      If nType < 100 Then  '100=vbext_ct_Document -- the only module type we would not want to copy
         Set vbcompTarget = wbTarget.VBProject.VBComponents.Add(nType)
         sText = vbcompSource.CodeModule.Lines(1, vbcompSource.CodeModule.CountOfLines)
         vbcompTarget.CodeModule.AddFromString (sText)
         vbcompTarget.Name = vbcompSource.Name
      End If
   Next vbcompSource
   
End Sub

 

[chadgaspard]

Getting a "wrong number of arguments or improper assignment" error when I try to run the Month_stuff. Something to do with "

Transfer_Well_Test RRR" portion of the code.​

 

[MoshiM]

Remove ",RR as range" from the DIM line in the second macro. I should also mention that the codes have been pieced together so that at runtime range("A43:N43") from the active sheet is applied to all daily worksheets.

If you don't want to use the active sheet at runtime then don't do the above . Instead remove the parameters from the second macro and then in the first remove the line that calls the sub and replace it with Set RRR= Activeworkbook.worksheets("2").range("A43:N43")

 

[chadgaspard]

So do I use the Month_Stuff Macro for page 1 of this thread in addition to the Month_Stuff Macro from this page of the thread (page 2)? My apologes as I am completely new to Macros.

 

[MoshiM]

So do I use the Month_Stuff Macro for page 1 of this thread in addition to the Month_Stuff Macro from this page of the thread (page 2)? My apologes as I am completely new to Macros.

Just use the one from Page 2. There were certain features I ignored on the page 1 macro

 

[chadgaspard]

Thanks. Ok I removed the RR as Range from the Dim Line from the Macro on page 2. I then ran the code and the DIM Line turned red and I got a "Compile Error: Expected: variable"

 

[MoshiM]

Thanks. Ok I removed the RR as Range from the Dim Line from the Macro on page 2. I then ran the code and the DIM Line turned red and I got a "Compile Error: Expected: variable"

It works fine on my end. Just to be sure at runtime you want to apply the range from the active sheet to all the others correct ?

If so, does the start of your "Transfer_Wells.." look like the following code. ByREF RR as range means the range is mandatory and is supplied when running the month stuff macro.

Sub Transfer_Well_Test(ByRef RR As Range)


'SAVE BEFORE USING THIS TO MAKE SURE IT DOES WHAT YOU WANT PROPERLY


Dim WS As Worksheet

 

[chadgaspard]

I want to apply to all days going forward. Not to the days that have already passed. I also do not want to apply it to the Monthly Report sheet either.

So to be sure I have got this right on my end, the Module should look like such:

Sub Month_Stuff()

Dim Target_Month_Days, Target_Month_Day_1 As Date, X As Long, WS1 As Worksheet, New_WB As Workbook, _
FileN As String, ERR_WS As Worksheet, RRR As Range

Transfer_Well_Test RRR

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

'Target_Month_Day_1 = DateSerial(2019, 12, 1) 'first day of Target Month if needed

Target_Month_Days = DateSerial(Year(Target_Month_Day_1), Month(Target_Month_Day_1) + 1, 1) - Target_Month_Day_1

'first day of (Target_Month_Day_1 + 1 MONTH) - Target_Month_Day_1 = number of days in Tareget Month

Set New_WB = Workbooks.Add 'create new workbook and store object in a variable

Set WS1 = New_WB.Worksheets(1) 'first worksheet of the newly created workbook

Application.EnableEvents = False

On Error Resume Next

For X = 1 To Target_Month_Days 'loop 1 to the number of days found in the target month

Set ERR_WS = ThisWorkbook.Worksheets(CStr(X)) 'this will generate an error if it doesn't exist

If Err.Number = 0 Then 'if the worksheet exists then copy it to the new Workbook

If X = 1 Then
ERR_WS.Copy After:=WS1
Else
ERR_WS.Copy Before:=WS1
End If

Else 'If it doesn't exit then create it within the new workbook and rename it

With New_WB.Worksheets.Add
.Move Before:=WS1
.Name = CStr(X)
.Range(RRR.Address) = RRR
End With

Err.Clear 'clear the generated error

End If

Next X

With New_WB

ThisWorkbook.Worksheets("Monthly Report").Copy Before:=.Worksheets(1) 'Copy Monthly Report to new Worksheet

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

.Worksheets("Monthly Report").Range("B10") = DateSerial(Year(Target_Month_Day_1), Month(Target_Month_Day_1), 1) 'First Day of upcoming Month

End With

With Application

.EnableEvents = True

.DisplayAlerts = False
WS1.Delete
.DisplayAlerts = True

End With
CopyModules ThisWorkbook, New_WB
FileN = ThisWorkbook.Path & "" & "Aspen DPR " & Month(Target_Month_Day_1) & "-" & Mid(Year(Target_Month_Day_1), 3, 2) & ".xlsb"

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

End Sub

Sub Transfer_Well_Test(ByRef RR As Range)

'SAVE BEFORE USING THIS TO MAKE SURE IT DOES WHAT YOU WANT PROPERLY

Dim WS As Worksheet,

Set RR = ActiveWorkbook.ActiveSheet.Range("A43:N43") 'store this range in a variable

For Each WS In ActiveWorkbook.Worksheets

With WS

If Not WS Is ActiveWorkbook.ActiveSheet And IsNumeric(.Name) Then

If CLng(.Name) <= 31 Then .Range("A43:N43") = RR

End If

End With

Next

End Sub

Sub CopyModules(wbSource As Workbook, wbTarget As Workbook)

Dim vbcompSource As VBComponent, vbcompTarget As VBComponent
Dim sText As String, nType As Long

For Each vbcompSource In wbSource.VBProject.VBComponents
nType = vbcompSource.Type
If nType < 100 Then '100=vbext_ct_Document -- the only module type we would not want to copy
Set vbcompTarget = wbTarget.VBProject.VBComponents.Add(nType)
sText = vbcompSource.CodeModule.Lines(1, vbcompSource.CodeModule.CountOfLines)
vbcompTarget.CodeModule.AddFromString (sText)
vbcompTarget.Name = vbcompSource.Name
End If
Next vbcompSource

End Sub

 

[MoshiM]

I want to apply to all days going forward. Not to the days that have already passed.

Can you elaborate on this ? Can you provide an example as well?

 

[chadgaspard]

Yes. So

if I enter data for a new well test on day 2, I want to be able to click the Transfer Well Test Button and; it copy the cell range for day 2 and paste it to the same cell range for days 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, and 1​

if I enter data for a new well test on day 6, I want to be able to click the Transfer Well Test Button and; it copy the cell range for day 6 and paste it to the same cell range for days 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, and 1 (1 being the last sheet representing the 1st day of the upcoming month. This is this way because there is a "Production Date" and a "Report Date". The sheet numbers represent the "Report Date")

if I enter data for a new well test on day 10, I want to be able to click the Transfer Well Test Button and; it copy the cell range for day 10 and paste it to the same cell range for days 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, and 1.

In addition, when I click the "Transfer To New Month" button on the last sheet (1) I would like the well test data to transfer to all pages in the new workbook that was copied from the active workbook along with the macros. If the upcoming months have more days, or less days, I would like it to adjust accordingly. By adjust accordingly I mean paste the correct number of sheets for the upcoming month and paste the well test data into all of the numbered sheets that represent a day. I don't want it to paste into the Monthly Report Sheet though because it does not contain cells to capture well test data.
​