Anyone who can help with this, will be appreciated!!!
I'm apologizing first, not very skilled at VBA, rather just excel skilled. My VBA knowledge is based from example codes googled from forums such as OzGrid
If my code is a bit untidy, please I'm still learning...
Regarding my project below...I have modified a code, that I've used before to extract data from multiple worksheets into a summary sheet, as once off register sheet. The code below is however intended to run on weekly basis.
My "master" sheet is (in a separate workbook with all the employee's yearly info, each employee on different worksheet with numerous and lengthy formulas) called "Shift Hours Per Employee", I need to import weekly info from .xlsb files from specific folder. (This should be from the earliest date first working through to the newest date as a once-off, thereafter it will be done weekly and the date order should not really matter) - I haven't managed to do a code for the date order yet.
The catch here is, I'm trying to do a loop where, with a vlookup formula, obtain the row address per employee code from the "Shift Hours Per Employee" sheet column A, transposing the extracted data from the .xlsb files into that row of the vlookup result (that matches the employee number) starting off at the first available column and thereafter proceeding to the next available column.
Please help
Option Explicit
Dim varWorkingWorkbook As Workbook
Dim Shift_Hours_Per_Employee As Worksheet
Dim FolderPath As String
Dim fileName As String
Dim ws As Worksheet
Dim counter As Long
Dim Shift As String
Dim EmployeeNumber As Object
Dim rng As Range
Dim i As Integer
Dim x As Long
Dim TargetRange As Range
Private Sub Workbook_Open()
Call varCopy_Shift_Allocation
End Sub
Private Function varCopy_Shift_Allocation() As Boolean
Dim iRow As Integer
iRow = (x = x + 3)
Dim lastrow As Long
lastrow = [Counta(Shift Hours Per Employee!A:A)]
Dim FSOLibrary As FileSystemObject
Dim FSOFolder As Object
'Dim sFolderPath As String
Dim sFileName As Object
Dim varFileSplit() As String
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Set Shift_Hours_Per_Employee = ActiveWorkbook.ActiveSheet
counter = 0
FolderPath = "E:\###\timesheets\"
'Call Dir the first time, pointing it to all Excel files in the folder path.
fileName = Dir(FolderPath) & "*" & ".xlsb"
Set FSOLibrary = CreateObject("Scripting.FileSystemObject")
Set FSOFolder = FSOLibrary.GetFolder(FolderPath)
Application.ScreenUpdating = False
'Loop until Dir returns an empty string
For Each sFileName In FSOFolder.Files
'Open a workbook in the folder
If Right(sFileName, 4) = "xlsb" Then
varFileSplit = Split(sFileName.Name, " - ")
If UBound(varFileSplit) > 0 Then
With Workbooks.Open(sFileName) '(sFileName = FolderPath & fileName)
Set varWorkingWorkbook = Workbooks.Open(sFileName, False, True)
For Each ws In varWorkingWorkbook.Worksheets
'Copy over the values from the source to the destination next row.
If Not ws Is Nothing Then
Dim nextRow As Integer
On Error GoTo MyErrorHandler:
For i = 5 To lastrow
Set TargetRange = varWorkingWorkbook.Worksheets("A:Q")
Set EmployeeNumber = getAddress(EmployeeNumber, varWorkingWorkbook.Worksheets("A:A"), 1)
Shift = Application.WorksheetFunction.VLookup(Sheets("Shift Hours Per Employee").Range("A:A"), TargetRange, 7, False)
If (Shift = Application.WorksheetFunction.VLookup(Sheets("Shift Hours Per Employee").Range("A:A"), TargetRange, 7, False)) <> "" Then
varWorkingWorkbook.Worksheets("G" & iRow + 6).Copy
'Set nextColumn = Sheets("Shift_Hours_Per_Employee").Range("F" & Column.Count).End(xlleft).Offset(1, 0) - need to start row 5, column F
'Sheets("Shift Hours Per Employee").Range("F" & "get address" for row number? + 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
'- start off column, next time code runs will be "G" and so forth
End If
counter = counter + 1
Next
'Close the source workbook without saving changes.
.Close SaveChanges:=False
End If
'Use Dir to get the next file name.
fileName = Dir()
Next
Application.ScreenUpdating = True
'Call AutoFit on the destination sheet so that all data is readable.
Shift_Hours_Per_Employee.Columns.AutoFit
MsgBox counter & " workbooks consolidated. ", , "Consolidation Complete"
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
MyErrorHandler:
If Err.Number = 1004 Then
MsgBox "Employee Code not found"
End If
End With
End If
End If
Next
Exit Function
Loop
End Function
Function getAddress(EmployeeNumber As Variant, vlookupRange As Range, columnOffset As Integer)
getAddress = vlookupRange.Find(What:=EmployeeNumber).Offset(0, columnOffset).Address
With varWorkingWorkbook.Worksheets("A:A")
Debug.Print .Cells(WorksheetFunction.Match(EmployeeNumber, .Cells, 0), 1).Address
End With
End Function
Display More