Importing data from other workbook using VBA

[barbs706]

Hi there.

I'm trying to automate alot of my office workflow. I currently receive timesheets that then have to be entered into a cost control document. I have to go through each person and insert their hours worked (days & downtime) on the cost document under the relevant date. Depending on how many guys are working, it can take me over a day doing data entry!

Does anyone have any VBA code they are willing to share that could automate this process? I was thinking of a macro on the timesheet template, as the location of the cost document will never change. I've tried a few snippets of code I've found on other forums, but I simply can't get anything to work. The dates going across in a row on the cost sheet stumped me the most!

I've created an example timesheet and cost sheet in the format we currently use. Unfortunately, changing the format at this time isn't an option so hopefully some clever code could be implemented! Examples: https://drive.google.com/drive/folders/12RhJuLUNf-CKJoRua1gmRQyGW1ilTKkW?usp=sharing

Thanks in advance!

 

[tonyyy]

barbs706,

You might consider the following...

Sub TimeSheetToCostControl_1070680()
Dim wb1 As Workbook, wb2 As Workbook
Dim arr1 As Variant, arr2 As Variant
Dim i As Long, j As Long, k As Long

Set wb1 = ThisWorkbook
Set wb2 = Workbooks("Example Cost Sheet.xlsx")
arr1 = wb1.Sheets("Sheet1").Range("A10:N29")
arr2 = wb2.Sheets("Example Cost Sheet").Range("B3:AJ80")
For i = LBound(arr1, 1) To UBound(arr1, 1) 'Loop thru names on timesheet
    For j = LBound(arr2, 1) To UBound(arr2, 1) 'Loop thru names on cost sheet
        If arr1(i, 1) = arr2(j, 1) Then 'Match name
            If arr1(i, 5) = arr2(j, 3) Then 'Match shift
                For k = 5 To 35 'Loop thru dates on cost sheet
                    If arr1(i, 4) = arr2(1, k) Then 'Match date
                        arr2(j, k) = arr1(i, 8) 'Add hours to shift
                        arr2(j + 3, k) = arr1(i, 9) 'Add downtime to Option 1
                        Exit For
                    End If
                Next k
            End If
        End If
    Next j
Next i
With wb2.Sheets("Example Cost Sheet")
    .Range("B3:AJ80") = arr2
    .Range("E7:E41,E46:E80").Formula = "=SUM(F7:AJ7)"
    .Range("F4:AJ4,F43:AJ43").Formula = "=SUM(F7:F41)"
End With
MsgBox "We're done here!"
End Sub

The code should be pasted into the time sheet workbook. The cost sheet workbook must also be open before running the macro.

There is no down time shift on the cost sheet, so I arbitrarily chose to put down time into Option 1.

Cheers,

tonyyy

 

[barbs706]

That's exactly what I need! You have saved me so many hours of dull data entry?
Is there an error handler that could be added, so if a name on a time sheet doesn't appear on the cost sheet, it pops up a simple msgbox showing the name of the person?
I've tried a few combinations of on error, or else, but it gets stuck in a loop and doesn't actually return the persons name.

Many thanks!

 

[tonyyy]

Rather than an error handler, introduced a boolean variable - "found" - to designate if a match is... found. If found is true then the code continues to loop through the names on the time sheet. If found is false then that name is added to a MissingNames list... and displayed in a MsgBox at the end of the code.

Sub TimeSheetToCostControl_1070680()
Dim wb1 As Workbook, wb2 As Workbook
Dim arr1 As Variant, arr2 As Variant
Dim i As Long, j As Long, k As Long
Dim found As Boolean, MissingNames As String

Set wb1 = ThisWorkbook
Set wb2 = Workbooks("Example Cost Sheet.xlsx")
arr1 = wb1.Sheets("Sheet1").Range("A10:N29")
arr2 = wb2.Sheets("Example Cost Sheet").Range("B3:AJ80")
For i = LBound(arr1, 1) To UBound(arr1, 1) 'Loop thru names on timesheet
    found = False
    For j = LBound(arr2, 1) To UBound(arr2, 1) 'Loop thru names on cost sheet
        If arr1(i, 1) = arr2(j, 1) Then 'Match name
            found = True
            If arr1(i, 5) = arr2(j, 3) Then 'Match shift
                For k = 5 To 35 'Loop thru dates on cost sheet
                    If arr1(i, 4) = arr2(1, k) Then 'Match date
                        arr2(j, k) = arr1(i, 8) 'Add hours to shift
                        arr2(j + 3, k) = arr1(i, 9) 'Add downtime to Option 1
                        Exit For
                    End If
                Next k
            End If
        End If
    Next j
    If found = False Then
        If MissingNames = "" Then
            MissingNames = arr1(i, 1)
        Else
            MissingNames = MissingNames & vbCrLf & arr1(i, 1)
        End If
    End If
Next i
With wb2.Sheets("Example Cost Sheet")
    .Range("B3:AJ80") = arr2
    .Range("E7:E41,E46:E80").Formula = "=SUM(F7:AJ7)"
    .Range("F4:AJ4,F43:AJ43").Formula = "=SUM(F7:F41)"
End With
If MissingNames <> "" Then MsgBox "Name(s) not on Cost sheet:" & vbCrLf & vbCrLf & MissingNames
MsgBox "We're done here!"
End Sub