Copying Data from Time sheet to Summary sheet without opening summary file

prveen

New Member
Joined
Aug 20, 2015
Messages
13
Hi All,

I am new to VBA and i have been given assignment to simplify exciting time sheet which is manual task, i have two excel files one were we input our daily time sheet and i have another excel file were this daily time logs would be saved for the entire month. All VBA experts can you please help me in coding the same.

1) i want people to update there time here and the should be updated in the summary file without opening the summary excel file (which would be saved in folder)
2) Since we record the time on daily basis i want macro to paste the data after previous day data so end of the month i will use the data for KPI reporting.

Many Thanks in advance for the help
 

Some videos you may like

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.

juddaaaa

Board Regular
Joined
Jan 4, 2020
Messages
208
Office Version
  1. 365
Platform
  1. Windows
This could be done with ADODB. I have a similar thing set up for Scheduling.

It would be helpful if you could share a sample of the 2 files (minus any sensitive data)
 

prveen

New Member
Joined
Aug 20, 2015
Messages
13
This could be done with ADODB. I have a similar thing set up for Scheduling.

It would be helpful if you could share a sample of the 2 files (minus any sensitive data)

Thanks for the quick reply,

I am not able to upload the excel files(i do not have any sensitive information) but have used the forum rules method posting the screen shot.

My first file- Daily Time Recorder.xlsx has 6 sheets with respective person name on sheet- example as per below 1st sheet is PK,and second sheet name is SK (Hoping i can edit the names)

Daily Time Recorder.xlsx
ABCDEF
1DateName ActivitySub ActivityUPT TimeComments
22/8/2020SKMeetingClient Review30
32/8/2020SKMeetingUpdate to client30
42/8/2020SKDesigningNew Client240
52/8/2020SKMeetingClient Review30
62/8/2020SKMeetingUpdate to client20
72/8/2020SKMeetingUpdate to client20
82/8/2020SKMeetingUpdate to client20
92/8/2020SKMeetingUpdate to client20
102/8/2020SKMeetingUpdate to client20
112/8/2020SKBreak60
12
13
14Total (mins)4908.1666667
SK


Also if we can put alert box - Incase person is updating the data for already existing dates

Second file is Summary-Timesheet


Summary-TimeSheet.xlsx
ABCDEF
1DateName ActivitySub ActivityUPT TimeComments
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Summay
 

juddaaaa

Board Regular
Joined
Jan 4, 2020
Messages
208
Office Version
  1. 365
Platform
  1. Windows
For this to work both your files will need to be saved as Macro Enabled Workbook (.xlsm)

Also you will need a button or something on each sheet in Daily Time Recorder to trigger the macro.

Insert a new Module in Daily Time Recorder and paste this into it.
VBA Code:
Sub UpdateSummary()

    Dim cn As Object, cm As Object, rs As Object
    Dim dte As Double, nme As String, activity As String, sub_activity As String, upt_time As Integer, comments As String
    Dim lr As Long
    Dim cc As Range
  
    On Error GoTo err_handler
  
    Set cn = CreateObject("ADODB.Connection")
    Set cm = CreateObject("ADODB.Command")
  
    With cn
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .Properties("Data Source") = ThisWorkbook.Path & "\Summary-TimeSheet.xlsm"
        .Properties("Extended Properties") = "Excel 12.0 Macro; HDR=YES; IMEX=0"
        .Open
    End With
  
    cm.ActiveConnection = cn
    cm.CommandText = "SELECT Date FROM [Summary$] WHERE Date = " & ActiveSheet.Range("A2")
    Set rs = cm.Execute
  
    If Not (rs.BOF And rs.EOF) Then
        MsgBox "Data for this date has already been submitted", vbInformation
        Exit Sub
    End If
  
    With ActiveSheet
        lr = .Cells(.Rows.Count, "A").End(xlUp).Row
          
        For Each cc In .Range("A2:A" & lr)
            dte = CDbl(cc.Offset(0))
            nme = cc.Offset(, 1)
            activity = cc.Offset(, 2)
            sub_activity = cc.Offset(, 3)
            upt_time = CDbl(cc.Offset(, 4))
            comments = cc.Offset(, 5)
          
            cm.CommandText = "INSERT INTO [Summary$] ([Date],[Name],[Activity],[Sub Activity],[UPT Time],[Comments]) VALUES (" & _
                              dte & ", " & _
                              "'" & nme & "', " & _
                              "'" & activity & "', " & _
                              "'" & sub_activity & "', " & _
                              upt_time & ", " & _
                              "'" & comments & "')"
            cm.Execute
        Next cc
    End With
  
exit_handler:
    Set rs = Nothing
    Set cm = Nothing
    Set cn = Nothing
  
Exit Sub

err_handler:
    MsgBox "Function UpdateSummary" & vbNewLine & vbNewLine & Err.Number & ": " & Err.Description, vbCritical, "Error in Function UpdateSummary"
    Resume exit_handler
  
End Sub

Then, in Summary-TimeSheet, in ThisWorkbook module paste this
VBA Code:
Private Sub Workbook_Open()

    Dim cc As Range
  
    With Sheets("Summary")
        For Each cc In .Range("A2:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)
            With cc
                .Value = CDate(CDbl(.Value))
                .NumberFormat = "M/D/YYYY"
              
                With .Offset(, 4)
                    .Value = CInt(.Value)
                    .NumberFormat = "0"
                End With
            End With
        Next cc
    End With
End Sub

This second part is because ADODB inserts everything as text and this will convert your dates back to dates and numbers back to numbers
 

juddaaaa

Board Regular
Joined
Jan 4, 2020
Messages
208
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

Quick edit to above to get MsgBox working
VBA Code:
Sub UpdateSummary()

    Dim cn As Object, cm As Object, rs As Object
    Dim dte As Double, nme As String, activity As String, sub_activity As String, upt_time As Integer, comments As String
    Dim lr As Long
    Dim cc As Range
   
    On Error GoTo err_handler
   
    Set cn = CreateObject("ADODB.Connection")
    Set cm = CreateObject("ADODB.Command")
   
    With cn
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .Properties("Data Source") = ThisWorkbook.Path & "\Summary-TimeSheet.xlsm"
        .Properties("Extended Properties") = "Excel 12.0 Macro; HDR=YES; IMEX=0"
        .Open
    End With
   
    cm.ActiveConnection = cn
    cm.CommandText = "SELECT Date FROM [Summary$] WHERE Date = " & CDbl(ActiveSheet.Range("A2"))
    Set rs = cm.Execute
   
    If Not (rs.BOF And rs.EOF) Then
        MsgBox "Data for this date has already been submitted", vbInformation
        Exit Sub
    End If
   
    With ActiveSheet
        lr = .Cells(.Rows.Count, "A").End(xlUp).Row
           
        For Each cc In .Range("A2:A" & lr)
            dte = CDbl(cc.Offset(0))
            nme = cc.Offset(, 1)
            activity = cc.Offset(, 2)
            sub_activity = cc.Offset(, 3)
            upt_time = CDbl(cc.Offset(, 4))
            comments = cc.Offset(, 5)
           
            cm.CommandText = "INSERT INTO [Summary$] ([Date],[Name],[Activity],[Sub Activity],[UPT Time],[Comments]) VALUES (" & _
                              dte & ", " & _
                              "'" & nme & "', " & _
                              "'" & activity & "', " & _
                              "'" & sub_activity & "', " & _
                              upt_time & ", " & _
                              "'" & comments & "')"
            cm.Execute
        Next cc
    End With
   
exit_handler:
    Set rs = Nothing
    Set cm = Nothing
    Set cn = Nothing
   
Exit Sub

err_handler:
    MsgBox "Function UpdateSummary" & vbNewLine & vbNewLine & Err.Number & ": " & Err.Description, vbCritical, "Error in Function UpdateSummary"
    Resume exit_handler
   
End Sub

VBA Code:
Private Sub Workbook_Open()

    Dim cc As Range
   
    With Sheets("Summary")
        For Each cc In .Range("A2:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)
            With cc
                If .Value <> Empty Then
                    .Value = CDbl(.Value)
                    .NumberFormat = "M/D/YYYY"
                   
                    With .Offset(, 4)
                        If .Value <> Empty Then
                            .Value = CInt(.Value)
                            .NumberFormat = "0"
                        End If
                    End With
                End If
            End With
        Next cc
    End With
End Sub
 

prveen

New Member
Joined
Aug 20, 2015
Messages
13
Thanks for the response really appreciate it, i am getting error "Function UpdateSummary"-2147467259:Summary$'is not a valid name. Make sure that it does not include invalid characterts or punctuation and that it is not too long.

I have followed all instruction correctly is there something else i need to do
 

prveen

New Member
Joined
Aug 20, 2015
Messages
13

ADVERTISEMENT

Apologies i got the sheet name incorrect so was getting above error, but now i have correct it and i am getting new error "The Insert INTO statement contains the following unknown field name:'Name'. Make sure you have typed the name correctly,and try the operation again.

Not sure which part of code needs to be corrected. Also do i need keep the Summary-Timesheet open while updating( which i do not want) people to know.
 

juddaaaa

Board Regular
Joined
Jan 4, 2020
Messages
208
Office Version
  1. 365
Platform
  1. Windows
Are the headers in the Summary sheet the same as what you provided in your sample?

It's really important that everything is the same as the code relies on it.

And no, you don't have to have the Summary sheet open.
 

prveen

New Member
Joined
Aug 20, 2015
Messages
13
Its matching see the screenshot below
Daily Time Recorder.xlsm
ABCDEF
1DateName ActivitySub ActivityUPT TimeComments
SK


Summary-TimeSheet.xlsm
ABCDEF
1DateName ActivitySub ActivityUPT TimeComments
Summary
 

juddaaaa

Board Regular
Joined
Jan 4, 2020
Messages
208
Office Version
  1. 365
Platform
  1. Windows
I think there maybe a space after the word Name in that cell in the Summary sheet.

Even small things like that can throw off the code

Can you see the difference when I select the text
Name.JPG
Activity.JPG
 

Watch MrExcel Video

Forum statistics

Threads
1,122,995
Messages
5,599,256
Members
414,299
Latest member
thenewworld

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
Top