Merge Shift Timesheet Files Into Monthly Reports

    I am somewhat familiar with excel, but it’s been a while since I've used it. A little background on the project I am working on: At the end of each shift, each employee fills out an Excel spread sheet (equipped with macros, etc, I did not do create this template) as to what they did that day and how long they spent doing it. The spread sheet is set up as for one month. At the end of the month, they submit the file to their supervisor, who then looks at the tally on the last page of the excel file. It shows what parentage of each activity they did was and displays it as a pie chart, bar graph, etc.


    What I want to try to do is create a way for him to be able to go into an excel spread sheet (one that I would create) and be able to select any number of monthly logs and combin them into one excel file with the same format as the orignal logs, most importantly the end of month summary.


    As a note, it is not letting me upload the log file, will e-mail those who are interested. Paying 50 dollars.

    Re: Merge Shift Timesheet Files Into Monthly Reports


    Kyle
    I have used Kris before and He does very good work.

    Jim
    "The problem with designing vba code completely foolproof is to underestimate the ingenuity of a complete fool."

    Re: Merge Shift Timesheet Files Into Monthly Reports


    Hi Kyle,


    With ref. to your PM


    Quote

    Is there anyway to have the macro you made combin all the data into just one tab, instead of seperate tabs for each person selected? Kind of a grand total for the entire month of all those selected?


    Replace all the userform code with the following.


    [vba]Public fCount As Long
    Public DirPath As String
    Function FILELIST(MyDir As String) As Variant
    '/this function creates a list of xls files from a directory
    Dim FileName As String, i As Long, fList()
    If Right$(MyDir, 1) <> "\" Then MyDir = MyDir & "\" 'adds "/" if it's missing
    FileName = Dir(MyDir & "*.xls")
    Do While FileName <> ""
    i = i + 1
    ReDim Preserve fList(1 To i)
    fList(i) = FileName
    FileName = Dir
    Loop
    If i > 0 Then
    FILELIST = fList
    fCount = i
    End If
    End Function


    Private Sub cmdGS_Click()
    Dim n As Long, f(), j As Long, aWB As Workbook
    Dim wb As Workbook, ws As Worksheet, k As Long
    Dim sn As String, sht As Worksheet, i As Long
    Dim mTot(1 To 34, 1 To 1), disTot(1 To 12, 1 To 1)
    Dim gTot(1 To 6, 1 To 1), tTot(1 To 34, 1 To 1), dTot(1 To 1, 1 To 1)
    Dim mTotS, disTotS, gTotS, tTotS, dTotS
    Set aWB = ActiveWorkbook
    ReDim f(1 To fCount) 'stores only selected file(s)
    With Application
    .ScreenUpdating = 0
    .EnableEvents = 0
    .DisplayAlerts = 0
    End With
    For n = 0 To Me.lbMLIST.ListCount - 1 'counts selected files from listbox
    If Me.lbMLIST.Selected(n) Then
    j = j + 1: f(j) = Me.lbMLIST.List(n)
    End If
    Next
    If j > 0 Then 'if selected
    For n = 1 To j
    'opens the workbook
    Set wb = Workbooks.Open(FileName:=DirPath & f(n), updatelinks:=0)
    'set the summary sheet
    Set ws = wb.Sheets("Monthly summary")
    'ranges to be summed.total 5
    mTotS = ws.Range("d4:d37").Value
    disTotS = ws.Range("l4:l15").Value
    gTotS = ws.Range("a55:a60").Value
    tTotS = ws.Range("e81:e114").Value
    dTotS = ws.Range("e116").Value
    For i = 1 To 5
    Select Case i
    Case 1
    For k = 1 To UBound(mTotS, 1)
    mTot(k, 1) = mTot(k, 1) + mTotS(k, 1)
    Next
    Case 2
    For k = 1 To UBound(disTotS, 1)
    disTot(k, 1) = disTot(k, 1) + disTotS(k, 1)
    Next
    Case 3
    For k = 1 To UBound(gTotS, 1)
    gTot(k, 1) = gTot(k, 1) + gTotS(k, 1)
    Next
    Case 4
    For k = 1 To UBound(tTotS, 1)
    tTot(k, 1) = tTot(k, 1) + tTotS(k, 1)
    Next
    Case 5
    For k = 1 To 1
    dTot(k, 1) = dTot(k, 1) + dTotS
    Next
    End Select
    Next
    wb.Close False: Set wb = Nothing: Set ws = Nothing
    Next
    With aWB.Sheets(1) 'stores value from source file into destination range
    .Range("d4:d37").Value = mTot
    .Range("l4:l15").Value = disTot
    .Range("a55:a60").Value = gTot
    .Range("e81:e114").Value = tTot
    .Range("e116").Value = dTot
    End With
    End If
    Unload Me
    With Application
    .ScreenUpdating = 1
    .EnableEvents = 1
    .DisplayAlerts = 1
    End With
    End Sub
    Private Sub UserForm_Initialize()
    Dim fList
    'this will be your source path where your monthly log files stored
    DirPath = "C:\Test" 'change source path here
    fList = FILELIST(DirPath)
    If Not IsEmpty(fList) Then
    With Me
    .lbMLIST.Clear
    .lbMLIST.List = Application.Transpose(fList)
    End With
    End If
    End Sub[/vba]


    HTH

Participate now!

Don’t have an account yet? Register yourself now and be a part of our community!

Register Yourself Login