transpose data extracted into row address obtained from vlookup at start off column and there after next column for each value in master sheet A:A

Hi I need help with the subject matter. And as I am fairly new to Excel VBA, I am literally stuck on this for weeks now. I have googled the o's again out of google and found many related and most helpful articles, but not quite exactly something that I could figure out on my own to make this work, soo, any help with this would greatly be appreciated, please. If I need to upload sample files, let me know, please

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


|
Answer
Answer

On my side both macros work perfectly 

That is a problem on your side 

Not in the macro. 

Check if you have any other macros on the workbooks that might prevent the xlsb files from closing. 

For checking 

Try commenting the offending line and run the macro 

You will see how it works. 

I repeat and stress on the point 

BOTH MACROS HAVE BEEN SUCCESSFULLY TESTED ON MY SIDE 

THE FILES OPEN AND CLOSE WITH NO PROBLEM 

I WOULDN'T SEND YOU THE ANSWER OTHERWISE 

Please,
Consider marking this reply as the answer to your question if it does so.
It will help others in the community with similar problems or questions.
Thank you in advance


Regards
Jeovany CV

1 person found this reply helpful

·

Was this reply helpful?

Sorry this didn't help.

Great! Thanks for your feedback.

How satisfied are you with this reply?

Thanks for your feedback, it helps us improve the site.

How satisfied are you with this reply?

Thanks for your feedback.

Answer
Answer

Try to sandwich the the RED line in the code

With MasterWbk

           .Activate

           On Error GoTo skip

          Set employeeSh = .Sheets(eeSh))

************ the rest of the code *********

Thanks for the possitive feedback  :-)   :-)

Regards

Please,
Consider marking this reply as the answer to your question if it does so.
It will help others in the community with similar problems or questions.
Thank you in advance


Regards
Jeovany CV

1 person found this reply helpful

·

Was this reply helpful?

Sorry this didn't help.

Great! Thanks for your feedback.

How satisfied are you with this reply?

Thanks for your feedback, it helps us improve the site.

How satisfied are you with this reply?

Thanks for your feedback.

 
 

Question Info


Last updated July 24, 2021 Views 59 Applies to: