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