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
 

prveen

New Member
Joined
Aug 20, 2015
Messages
13
Correct...It works Fine now.....But when two people are updating for the same dates its not allowing and telling data is already available.. Probably small tweak in this required.
:- 2 or more people should be able to update for particular date. And please remove the "Also if we can put alert box - Incase person is updating the data for already existing dates " so incase if person forgets to update a particular date we can give a option to update.

Apologies if above can be incorporated it would complete my requirement.
 

Some videos you may like

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.

prveen

New Member
Joined
Aug 20, 2015
Messages
13
Also is there option to reset this to row2 once the month start again..currently it records last row item from where its left...or ifs there additional code so i can us to reset the data to row 2
 

juddaaaa

Board Regular
Joined
Jan 4, 2020
Messages
208
Office Version
  1. 365
Platform
  1. Windows
Probably small tweak in this required.

Correct.

Give this a go.
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 Name,Date FROM [Summary$] WHERE Name = '" & ActiveSheet.Range("B2") & "' AND 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
 

juddaaaa

Board Regular
Joined
Jan 4, 2020
Messages
208
Office Version
  1. 365
Platform
  1. Windows
Paste this into a new module in Summary-Timesheet
VBA Code:
Sub Reset()

    Dim lr As Long
    
    With Sheets("Summary")
        lr = .Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        
        If lr >= 2 Then
            .Range("A2:F" & lr).ClearContents
        End If
    End With

End Sub

and add a button or something to trigger it
 

prveen

New Member
Joined
Aug 20, 2015
Messages
13

ADVERTISEMENT

Thanks Juddaa its working perfectly...But problem is reset is not working after i clear the Summary Sheet and try doing from first it still copys the data from its left example from row 40 instead of row 1...how can this be fixed
 

juddaaaa

Board Regular
Joined
Jan 4, 2020
Messages
208
Office Version
  1. 365
Platform
  1. Windows
Try this
VBA Code:
Sub Reset()

    Dim lr As Long
    
    With Sheets("Summary")
        lr = .Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        
        If lr >= 2 Then
            .Rows("2:" & lr).EntireRow.Delete xlShiftUp
        End If
    End With

End Sub
 

prveen

New Member
Joined
Aug 20, 2015
Messages
13
Awesome this works fine...But when i reset the column in summary tab and try to update the sheet again first person can do it but when person from another sheet is updating its throwing error, reason is in Summary sheet the date format is getting changed to below format is there anything can be done for this?

Summary-TimeSheet.xlsm
A
1Date
243865
343865
443865
543865
643865
Summary



Also incase i need to add few more columns like "Region","Strategy" "Role" how do i add this
 

prveen

New Member
Joined
Aug 20, 2015
Messages
13
Hi All...Can anyone help me in adding a Date property to the above macro code. example- We only update the data for only given day...If Date column has 01/05/2020 and information relating to that date has to be updated in case if I have another date in the sheet its should not allow me.
 

Watch MrExcel Video

Forum statistics

Threads
1,122,295
Messages
5,595,294
Members
413,984
Latest member
stikpet

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