VBA open excel workbooks (without them popping up), and then copying one line item to a master sheet.

[PaulOPTC]

Good Afternoon,

Hoping for some help here, I clearly don't know what I am doing.


Here is the goal: To update my master spread sheet.

I am trying to implement a new project tracker, this will be an excel sheet, named exactly the same thing, for EVERY job.
It has a table in it on a hidden sheet.

Hidden sheet name: MasterTrackerLink
Table Name: MTLink

It only has one set of data and headers, starting in A1 (data is on A2)

My master workbook has a sheet called "Active"
That has the file paths to the workbooks that I would want to open, it also has 0s in the same row, if I am not trying to get that data.

Example:
This is Column O starting at O1

0​

L:\Projects\Service\Service Active\1564 - Folder Name\Weekly PM Folder\Project Tracker.xlsm

0​

0​

0​

0​

0​

0​

0​

0​

L:\Projects\Service\Service Active\1555 - Folder Name\Weekly PM Folder\Project Tracker.xlsm

0​

0​

0​

0​

0​

L:\Projects\Active\1549 - Folder Name\Weekly PM Folder\Project Tracker.xlsm

0​

My master workbook has another sheet called "Tracker Link" That the A2 data from the project trackers will need to be pasted (as values)



I would need a code to go through this list,
open up the project workbook (ideally with out it popping up for the user)
unhide the sheet, copy the data
paste the data on the master,
and then close the project workbook. (Doesnt need to save)


Here is what I tryed to make, based off google, and recording Macros.

Sub UpdateJobs()

Dim sh As Worksheet


Sheets("Master Cover Sheet").Select
 Range("A1").Select
 
  Sheets("Tracker Link").Visible = True
    Sheets("Active").Visible = True
 
Sheets("Active").Select

Columns("N:N").Select
    Selection.Copy
    Columns("O:O").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

 Set Rng = Range("O1" & Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row)

    For i = Rng.Cells.Count To 1 Step -1
        If Rng(i).Value <> 0 Then
        
     Set sh = GetObject(Rng(i).Value).Worksheets("MasterTrackerLink")
 
  Sheets("MasterTrackerLink").Visible = True
  Sheets("TrackerLink").Select
   Range("A2:L2").Select
  
   Sheets("Tracker Link").Select
  
       Rows("2:2").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    
        Windows("Project Tracker.xlsm").Activate
    Range("MTLink").Select
    Selection.Copy
    Windows("Master Tracker.xlsm").Activate
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

' your codes here
sh.Parent.Close SaveChanges:=False 'Closes the associated workbook


Next i


End If


End Sub

This does not work at all, I only get errors, I don't know what I am doing.
Please Help

Thank you

 

[Max1616]

Hello! Give this a shot:

Sub test()

Dim wb0 As Workbook
Dim ws0 As Worksheet
Dim lrow0 As Long
Dim wsDest As Worksheet
Dim lrowDest As Long
Dim wb As Workbook
Dim ws As Worksheet

Application.ScreenUpdating = False 'Stop screen from showing what's going on

Set wb0 = ActiveWorkbook 'Variable for active workbook
Set ws0 = wb0.Sheets("Active") 'Variable for "Active" sheet
Set wsDest = wb0.Sheets("Tracker Link") 'Variable for the destination-sheet of the data

lrow0 = ws0.Cells(Rows.Count, 15).End(xlUp).Row 'Variable for last row of the links we need to loop through

For i = 1 To lrow0 ' Start the loop at 1 to lrow0: 1 because the links start in row 1, lrow0 becuase thats the number of times we need to loop through the links
    If ws0.Cells(i, 15) <> 0 Then 'Only do something if the link <> 0
       
        lrowDest = wsDest.Cells(Rows.Count, 1).End(xlUp).Row + 1 'Figure out the first open row in our destination sheet
   
        Set wb = Workbooks.Open(ws0.Cells(i, 15)) 'Open the link we are currently looping through and set it as a variable
        Set ws = wb.Sheets("MasterTrackerLink") 'Set the sheet we are copying from as a variable
        ws.Visible = xlSheetVisible 'Unhide the sheet
       
        ws.Range("A2:A" & ws.Cells(Rows.Count, 1).End(xlUp).Row).Copy 'Copy the data
        wsDest.Range("A" & lrowDest).PasteSpecial xlPasteValues 'Paste the data in the first avaialble row (lrowDest)
        wb.Close False 'Close the workbook we just opened
       
    End If
Next i 'Loop through the next link

Application.ScreenUpdating = True 'Turn the ability to see what Excel is doing back on

End Sub

 

[PaulOPTC]

Hello! Give this a shot:

Sub test()

Dim wb0 As Workbook
Dim ws0 As Worksheet
Dim lrow0 As Long
Dim wsDest As Worksheet
Dim lrowDest As Long
Dim wb As Workbook
Dim ws As Worksheet

Application.ScreenUpdating = False 'Stop screen from showing what's going on

Set wb0 = ActiveWorkbook 'Variable for active workbook
Set ws0 = wb0.Sheets("Active") 'Variable for "Active" sheet
Set wsDest = wb0.Sheets("Tracker Link") 'Variable for the destination-sheet of the data

lrow0 = ws0.Cells(Rows.Count, 15).End(xlUp).Row 'Variable for last row of the links we need to loop through

For i = 1 To lrow0 ' Start the loop at 1 to lrow0: 1 because the links start in row 1, lrow0 becuase thats the number of times we need to loop through the links
    If ws0.Cells(i, 15) <> 0 Then 'Only do something if the link <> 0
      
        lrowDest = wsDest.Cells(Rows.Count, 1).End(xlUp).Row + 1 'Figure out the first open row in our destination sheet
  
        Set wb = Workbooks.Open(ws0.Cells(i, 15)) 'Open the link we are currently looping through and set it as a variable
        Set ws = wb.Sheets("MasterTrackerLink") 'Set the sheet we are copying from as a variable
        ws.Visible = xlSheetVisible 'Unhide the sheet
      
        ws.Range("A2:A" & ws.Cells(Rows.Count, 1).End(xlUp).Row).Copy 'Copy the data
        wsDest.Range("A" & lrowDest).PasteSpecial xlPasteValues 'Paste the data in the first avaialble row (lrowDest)
        wb.Close False 'Close the workbook we just opened
      
    End If
Next i 'Loop through the next link

Application.ScreenUpdating = True 'Turn the ability to see what Excel is doing back on

End Sub

Hey!

Thank you for the reply and for your help!,

It worked!
untill it got to one of the older ones that did not have this project tracker in it,
But that was my fault, I forgot the older projects do not use the project tracker

I think I would also need one line item in there that says that if the file is not found, that it skips it. If possible.

Otherwise I can just throw a dummy file in there and call it a day!

 

[PaulOPTC]

Hey!

Thank you for the reply and for your help!,

It worked!
untill it got to one of the older ones that did not have this project tracker in it,
But that was my fault, I forgot the older projects do not use the project tracker

I think I would also need one line item in there that says that if the file is not found, that it skips it. If possible.

Otherwise I can just throw a dummy file in there and call it a day!

Same thing if someone has one of these trackers open it gives the error,


Maybe an On error line, to skip and then keep going? or make a list of the ones that did not update because of the error?

Not sure what is possible! Thanks again for your help!

 

[Max1616]

Here's how I would deal with the workbooks that are already open (Open them in read only so it doesn't matter). As for the workbooks that this should skip, it's very doable, but I would need some criteria on how to identify the workbook without the tracker (for example, is there a specific field I could reference, and if there's no data in that field, I can write some code to skip the logic.

Sub test()

Dim wb0 As Workbook
Dim ws0 As Worksheet
Dim lrow0 As Long
Dim wsDest As Worksheet
Dim lrowDest As Long
Dim wb As Workbook
Dim ws As Worksheet

Application.ScreenUpdating = False 'Stop screen from showing what's going on

Set wb0 = ActiveWorkbook 'Variable for active workbook
Set ws0 = wb0.Sheets("Active") 'Variable for "Active" sheet
Set wsDest = wb0.Sheets("Tracker Link") 'Variable for the destination-sheet of the data

lrow0 = ws0.Cells(Rows.Count, 15).End(xlUp).Row 'Variable for last row of the links we need to loop through

For i = 1 To lrow0 ' Start the loop at 1 to lrow0: 1 because the links start in row 1, lrow0 becuase thats the number of times we need to loop through the links
    If ws0.Cells(i, 15) <> 0 Then 'Only do something if the link <> 0
       
        lrowDest = wsDest.Cells(Rows.Count, 1).End(xlUp).Row + 1 'Figure out the first open row in our destination sheet
   
        Set wb = Workbooks.Open(Filename:=ws0.Cells(i, 15), ReadOnly:=True)
        'Open the link we are currently looping through and set it as a variable
        Set ws = wb.Sheets("MasterTrackerLink") 'Set the sheet we are copying from as a variable
        ws.Visible = xlSheetVisible 'Unhide the sheet
       
        ws.Range("A2:A" & ws.Cells(Rows.Count, 1).End(xlUp).Row).Copy 'Copy the data
        wsDest.Range("A" & lrowDest).PasteSpecial xlPasteValues 'Paste the data in the first avaialble row (lrowDest)
        wb.Close False 'Close the workbook we just opened
       
    End If
Next i 'Loop through the next link

Application.ScreenUpdating = True 'Turn the ability to see what Excel is doing back on

End Sub