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

P

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
 

Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result
Sort by date Sort by votes
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)
 
Upvote 0
juddaaaa said:
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)
Click to expand...

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

Similar threads

J
  • Locked
  • Question
Still need help on a daily summary sheet
Replies
1
Views
287
Fluff
Fluff
H
  • Solved
How to copy data from one file and paste it into a dynamically named workbook
Replies
3
Views
175
dermie_72
D
J
  • Question
Run time error with VBA to copy Chart objects from closed workbook
Replies
4
Views
115
Domenic
D
P
  • Question
Complete Summary Table with data from multiple sheets
Replies
6
Views
287
pioshelby1980com
P
P
  • Question
Need suggestions on what to use for a real time tracker which auto refreshes the data every hour.
Replies
1
Views
74
Peter_SSs
Peter_SSs

Forum statistics

Threads
1,214,784
Messages
6,121,536
Members
449,037
Latest member
tmmotairi

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