Compile Data into a Master File

[Mirres]

I have project spreadsheets that list Projected hours each employee is expected to work per month.

I have a master spreadsheet that has tabs for each quarter. Each tab has the project number across the top, and each employee down the left.

I am trying to make a Macro that will open each project spreadsheet, find the proper column for that project in the Master, then add the hours each employee worked that quarter from the project sheet to the master sheet.

The section of code to open the spreadsheets works fine, it's legacy code from someone that knew what they were doing. The search finds the correct project, but it tells me it is column 34, but AJ is 36. No idea what causes that discrepancy. Have not yet written the code to copy over the hours yet.

Sub Main()

    On Error Resume Next
    Application.DisplayAlerts = False
    Dim MyFodler As String
    Dim MyFile As String
    Dim PFile As Workbook
    Workbooks.Open ("C:\Users\RMQ2.xlsx")
    MyFolder = "C:\Users\Janice\Roast"
    MyFile = Dir(MyFolder & "\*.xlsx")
    Do While MyFile <> ""
        Workbooks.Open FileName:=MyFolder & "\" & MyFile
        MyFile = Dir
    
    PFile = Workbook.Active
        
    Dim Project As String
        Project = Workbooks(PFile).Range("C1")
               
     
        Workbooks("RMQ2.xlsx").Activate
        Rows("4:4").Select
'Row of the master sheet that has the project numbers
        Selection.Find(What:=Project, After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
        
Dim iCol As Integer
    iCol = ActiveCell.Column
'Gives the column to paste in later.

MsgBox iCol, vbInformation
'Check that it's giving the right one. Seems not.

    
        
 'Following code is still very raw, not working.    
Dim lRow As Long
Dim iRow As Long
Dim MRow As Long
Dim Rng As Range
'somehow get it to use the names in PFile column B, starting at row 54 to row 145-ish to match the RMQ2 name and math from PFile to RMQ2.
    
    
    For iRow = 54 To lRow Step 1

    Next iRow


Workbooks(RMQ2.xlsx).Activate

      Loop


    MsgBox "Finshed...", vbInformation

End Sub

 

[Mirres]

Updated my code. Currently everything works great until the second search, which is looking for the name from the PFile project workbook in the RMQ2.xlsx master file. Run time 438 right now.

Sub Main()

    
    Application.DisplayAlerts = False
    Dim MyFolder As String, MyFile As String, Project As String, Name As String
    Dim CRow As Long, MRow As Long, iRow As Long
    Dim PFile As Workbook
    Dim Rng As Range
    Dim lRow As String
    
    
    Workbooks.Open ("C:\Users\502197807\Documents\Roast Files\Janice\RMQ2.xlsx")
    MyFolder = "C:\Users\502197807\Documents\Roast Files\Janice\Roast"
    MyFile = Dir(MyFolder & "\*.xlsx")
    Do While MyFile <> ""
        Set PFile = Workbooks.Open(FileName:=MyFolder & "\" & MyFile)
                MyFile = Dir
    
    
    'If PFile Is Nothing Then 'check that something was found.
    '   MsgBox Prompt:="The Workbook is not available", Buttons:=vbOKOnly + vbInformation
    'End If
       
    
        Project = Range("C1").Value
        
        'MsgBox "*" & Project 'check Project output
        
        Workbooks("RMQ2.xlsx").Activate
        Rows("4:4").Select
        Selection.Find(What:=Project, After:=ActiveCell, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, _
        SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
        
Dim iCol As Integer
    iCol = ActiveCell.Column
    'MsgBox iCol, vbInformation 'check iCol output
    
    PFile.Activate
    
    lRow = Cells(Rows.Count, 1).End(xlUp).Row
    'MsgBox lRow, vbInformation 'check lrow output
    
    For iRow = 54 To lRow Step 1 'Names start at row 54, end near 148. Not every row in this range is a name.
    
        
    Workbooks("RMQ2.xlsx").Activate 'search Master workbook for the name
        Range("E:E").Select
        Selection.Find(What:=PFile.Range(iRow, 2), After:=ActiveCell, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, _
        SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
    
    

  

    
    Next iRow
       


Workbooks(RMQ2.xlsx).Activate



    
    Loop


    MsgBox "Finshed...", vbInformation

End Sub