Clone worksheets, date/time functions (and God knows what else)

[Archangelos]

Hello from Greece. A new, small project has started. A good and loyal colleague needs help with data entry of measurements.

Let's start from the begining.

Introduction
Since the first of the year, the colleagues from a neighboring department take measurements from a number of pieces of equipment. Each day, the fill a sheet of paper with the numbers they have taken manually.

That means that up to now we have about 120 sheets of paper filled with numbers. You can see them in the following picture.

The final goal would be to have a database with all these data but ... this is too far. The first step would be to have the data entered in an excel sheet.

 

[Archangelos]

The first step: cloning the data entry sheet.
Firstly, all data must be entered into excel. This would be a boring and manually done task, therefore it has to be as easiest as possible.

In the following picture you can the prototype worksheet named ORGN (from the word Original).




This worksheet has to cloned, one time for each date. For example, one worksheets named 180101 for 01/01/2018, another named 180102 for 02/01/2018 etc.

Obviously, to do it manually is not an option. Take a look at the following piece of code.

Sub ORGNtoMonthSheets()


Dim NewSheetName As String
Dim DoM As Date
Dim LoM As Date


DoM = DateSerial(2018, 1, 1)
LoM = DateSerial(2018, 1, 4)


Do While DoM <= LoM
   NewSheetName = Yemoda("ORGN", DoM)
   Sheets.Add(After:=Sheets(Sheets.Count)).Name = NewSheetName




   Sheets("ORGN").Cells.Copy
   Sheets(NewSheetName).Paste
   'Copies only data, no formatting 'Sheets(NewSheetName).Range("A1:J20").Value = Sheets("ORGN").Range("A1:J20").Value
   Sheets(NewSheetName).Cells(4, 12) = ""
   


DoM = DoM + 1
Loop




End Sub


Function Yemoda(ORsheet As String, IncomingDate As Date) As String
Dim GPint As Integer 'General purpose integer
Dim Temp As String
Dim DebugFlag As Boolean




DebugFlag = False




Sheets(ORsheet).Activate


'The first pair of YeModa digits: year
 GPint = Year(IncomingDate)
 If GPint > 1999 Then
    GPint = GPint - 2000
 Else
    GPint = GPint - 1900
 End If


 If GPint < 10 Then
    Temp = "0" & GPint
 Else
    Temp = GPint
 End If
 
 If DebugFlag = True Then
    Cells(1, 15) = Temp
 End If
 




'The second pair of YeModa digits: month
 GPint = Month(IncomingDate)
 If GPint < 10 Then
    Temp = Temp & "0" & GPint
 Else
    Temp = Temp & GPint
 End If


 If DebugFlag = True Then
    Cells(2, 15) = Temp
 End If


'The third pair of YeModa digits: day
 GPint = Day(IncomingDate)
 If GPint < 10 Then
    Temp = Temp & "0" & GPint
 Else
     Temp = Temp & GPint
 End If
 
 
  If DebugFlag = True Then
    Cells(3, 15) = Temp
 End If


Yemoda = Temp


End Function

The last picture shows the result of the code.



As you can see in the first picture, there is a URL in the L4 cell. I do not want this in the clones. The command Sheets(NewSheetName).Cells(4, 12) = "" helps me rectify the situation.

The second picture is inaccurate. When I took the screenshot that command was not there. However, if I clone the ORGN sheet the url of cell L4 will not be there, believe me.

 

[Archangelos]

The second step: date/time info in each clone sheet

As you can see in the pictures, rows B and C contain date/time information.

I need to set-up them so every clone has the correct date.

I had to play with the ORGNtoMonthSheets sub. Unfortunately, I have reached a dead end.

Sub ORGNtoMonthSheets()

Dim NewSheetName As String
Dim DoM As Date
Dim LoM As Date


DoM = DateSerial(2018, 1, 1)
LoM = DateSerial(2018, 1, 4)


Do While DoM <= LoM
   NewSheetName = Yemoda("ORGN", DoM)
   Sheets.Add(After:=Sheets(Sheets.Count)).Name = NewSheetName




   Sheets("ORGN").Cells.Copy
   Sheets(NewSheetName).Paste
   'Copies only data, no formatting 'Sheets(NewSheetName).Range("A1:J20").Value = Sheets("ORGN").Range("A1:J20").Value
   Sheets(NewSheetName).Cells(4, 12) = ""
   
   
   'The additional commands for date/time information.
   'Unfortuately, they do not work
   'Sheets(NewSheetName).Cells("B1") = DoM
   Sheets(NewSheetName).Cells("B2") = DoM + TimeValue("10:00:00")
   Sheets(NewSheetName).Cells("E2") = DoM + TimeValue("17:00:00")
   'Sheets(NewSheetName).Cells("H2") = DateValue(DoM) + TimeValue("23:00:00")




DoM = DoM + 1
Loop




End Sub

I have to admit that I do not understand all these dateserial and timevalue things. I copied them after having found them in the Internet but ... it does not work.


Guys, I need help.

 

[Archangelos]

Well, I managed to get a solution. It took a variant variable in order to finish with it. The code had to change a little bit.

The YeMoDa function remained the same.

ub ORGNtoMonthSheets()

Dim NewSheetName As String
Dim DoM As Date
Dim LoM As Date
Dim DomTime As Variant


DoM = DateSerial(2018, 1, 1)
LoM = DateSerial(2018, 1, 4)


Do While DoM <= LoM
   NewSheetName = Yemoda("ORGN", DoM)
   Sheets.Add(After:=Sheets(Sheets.Count)).Name = NewSheetName




   Sheets("ORGN").Cells.Copy
   Sheets(NewSheetName).Paste
   'Copies only data, no formatting 'Sheets(NewSheetName).Range("A1:J20").Value = Sheets("ORGN").Range("A1:J20").Value
   Sheets(NewSheetName).Cells(4, 12) = ""
   
   
   'The additional commands for date/time information.
   'Unfortuately, they do not work
   Sheets(NewSheetName).Range("b1").Value = DoM


   DomTime = DoM + TimeValue("10:00")
   Sheets(NewSheetName).Range("B2").Value = DomTime
   'Sheets(NewSheetName).Range("B2").Value = DoM + TimeValue("10:00:")
   
   
   DomTime = DoM + TimeValue("17:00")
   Sheets(NewSheetName).Range("E2").Value = DomTime
   'Sheets(NewSheetName).Cells("E2") = DoM + TimeValue("17:00:00")
   
   DomTime = DoM + TimeValue("23:00")
   Sheets(NewSheetName).Range("H2").Value = DomTime
   'Sheets(NewSheetName).Cells("H2") = DateValue(DoM) + TimeValue("23:00:00")




DoM = DoM + 1
Loop




End Sub




Function Yemoda(ORsheet As String, IncomingDate As Date) As String
Dim GPint As Integer 'General purpose integer
Dim Temp As String
Dim DebugFlag As Boolean




DebugFlag = False




Sheets(ORsheet).Activate


'The first pair of YeModa digits: year
 GPint = Year(IncomingDate)
 If GPint > 1999 Then
    GPint = GPint - 2000
 Else
    GPint = GPint - 1900
 End If


 If GPint < 10 Then
    Temp = "0" & GPint
 Else
    Temp = GPint
 End If
 
 If DebugFlag = True Then
    Cells(1, 15) = Temp
 End If
 




'The second pair of YeModa digits: month
 GPint = Month(IncomingDate)
 If GPint < 10 Then
    Temp = Temp & "0" & GPint
 Else
    Temp = Temp & GPint
 End If


 If DebugFlag = True Then
    Cells(2, 15) = Temp
 End If


'The third pair of YeModa digits: day
 GPint = Day(IncomingDate)
 If GPint < 10 Then
    Temp = Temp & "0" & GPint
 Else
     Temp = Temp & GPint
 End If
 
 
  If DebugFlag = True Then
    Cells(3, 15) = Temp
 End If


Yemoda = Temp


End Function