No announcement yet.

Merge Shift Timesheet Files Into Monthly Reports

This topic is closed.
  • Filter
  • Time
  • Show
Clear All
new posts

  • 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.

  • #2
    Re: Merge Shift Timesheet Files Into Monthly Reports

    Send the file to me.'ll let you know after seeing the file.

    See PM.



    • #3
      Re: Merge Shift Timesheet Files Into Monthly Reports

      I have used Kris before and He does very good work.
      "The problem with designing vba code completely foolproof is to underestimate the ingenuity of a complete fool."


      • #4
        Re: Merge Shift Timesheet Files Into Monthly Reports


        Pl. find attached. Place the file any folder other than your monthly log files stored.

        Also adjust the directory path in the code as well.

        Let me know how it's working for you.
        Attached Files



        • #5
          Re: Merge Shift Timesheet Files Into Monthly Reports

          Hi Kyle,

          With ref. to your PM

          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.

          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
          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
          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 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)
          Case 2
          For k = 1 To UBound(disTotS, 1)
          disTot(k, 1) = disTot(k, 1) + disTotS(k, 1)
          Case 3
          For k = 1 To UBound(gTotS, 1)
          gTot(k, 1) = gTot(k, 1) + gTotS(k, 1)
          Case 4
          For k = 1 To UBound(tTotS, 1)
          tTot(k, 1) = tTot(k, 1) + tTotS(k, 1)
          Case 5
          For k = 1 To 1
          dTot(k, 1) = dTot(k, 1) + dTotS
          End Select
          wb.Close False: Set wb = Nothing: Set ws = Nothing
          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.List = Application.Transpose(fList)
          End With
          End If
          End Sub




          • #6
            Re: Merge Shift Timesheet Files Into Monthly Reports

            That worked perfectly!! Thank you very much.


            • #7
              Re: Merge Shift Timesheet Files Into Monthly Reports




              • #8

                Re: Merge Shift Timesheet Files Into Monthly Reports

                Kyle, I got the money.

                Keep EXCELling.