Help with macros to open many files, and extract data. Need help with match / find.

[abssorb]

Based on an excellent start from here:

macro to pull all data from every file in a folder and copy Data into the open workbook?

Hi Everyone, I have a Work Book Called "New Document" I want to open and copy data into this document from lots of other workbooks? Basicly I get employees timesheets sent over to me every week, they are all the same and currently the data is being put into my excel document manually, I want...

www.mrexcel.com

I'm a VBA novice - mostly get results from standing on the shoulder of giants by cutting / pasting and fiddling around. I've been a unix/linux admin so know some stuff.

I'm building a tool to open a bunch of monthly reports, all stored in one folder. They use a consistent template but have varying filenames. I'm extracting key bits of information into an overall portfolio data set.
So what is working:
I can specify a windows path to a folder.
The macro will open each workbook in turn, and I can specify worksheets and extract data from cells, and collect into one sheet. Excellent for my needs.


I have one problem. On one of the worksheets, the data I need is consistent in columns, but I must match the row as it can change. Nothing I have tried works so far.
If I manually specify the row # in a variable, it works perfectly. But, if I try a match / find of any kind, excel stalls by opening the first file matching in the path, and stalling

Option Explicit


Const FOLDER_PATH = "C:\Users\REDACTED\EVIDENCE-COPY\"


Sub ImportWorksheets()
   '=============================================
   'Process all Excel files in specified folder
   '=============================================
   Dim sFile As String           'file to process
   Dim wsTarget As Worksheet
   Dim wbSource As Workbook
   Dim wsSource As Worksheet
   Dim ws As Worksheet
   Dim rowTarget As Long         'output row
   Dim matchTarget As Long       'Source row which matches criteria ME


 
   rowTarget = 2
 
   'check the folder exists
   If Not FileFolderExists(FOLDER_PATH) Then
      MsgBox "Specified folder does not exist, exiting!"
      Exit Sub
   End If
 
   'reset application settings in event of error
   On Error GoTo errHandler
   Application.ScreenUpdating = False
 
   'set up the target worksheet
   Set wsTarget = Sheets("Sheet2")
 
   'loop through the Excel files in the folder
   sFile = Dir(FOLDER_PATH & "EF*.xls*")
   Do Until sFile = ""
  
      'open the source file and set the source worksheet - ASSUMED WORKSHEET(1)
      Set wbSource = Workbooks.Open(FOLDER_PATH & sFile)
      Set wsSource = wbSource.Worksheets("Scope") 'EDIT IF NECESSARY
  
      'import the data
      With wsTarget
         .Range("A" & rowTarget).Value = wsSource.Range("D4").Value  'SAP Project Number
         .Range("B" & rowTarget).Value = wsSource.Range("D3").Value  'SAP Project Name
         .Range("C" & rowTarget).Value = wsSource.Range("D7").Value  'Customer Name
         .Range("D" & rowTarget).Value = wsSource.Range("J3").Value  'Report period
         .Range("E" & rowTarget).Value = wsSource.Range("J6").Value  'Project End Date
     
        Set wsSource = wbSource.Worksheets("Project Status") 'EDIT IF NECESSARY
     
         .Range("F" & rowTarget).Value = wsSource.Range("K12").Value  'RAG This Period

 
   Set wsSource = wbSource.Worksheets("Contract Value") 'EDIT IF NECESSARY
          .Range("H" & rowTarget).Value = wsSource.Range("D7").Value  'TCV
    
 ' Get Days Profile
   Set wsSource = wbSource.Worksheets("Labour forecast man days") 'EDIT IF NECESSARY
 
     
     ' Perform a lookup, to get the right row for the project manager.
   
        matchTarget = 13             ' This works PERFECTLY. But, can't guarantee it's always row 13.
    
' Commented out HELP NEEDED
'  Very many versions of the following "match" / search tried. All result in the source
    '  file opening, and the script stalling.
        '  matchTarget = Excel.WorksheetFunction.Match("Project Management", Range("E1:E298"), 0)  'Must be range starting with row 1 to work
  
  
     
         .Range("I" & rowTarget).Value = wsSource.Range("F6").Value  ' Budget days
         .Range("J" & rowTarget).Value = wsSource.Range("F6").Value  ' Total days
         .Range("K" & rowTarget).Value = wsSource.Range("J7").Value  ' First month of profile
         .Range("L" & rowTarget).Value = wsSource.Range("J" & matchTarget).Value  ' First PM Day Value - NEEDS A MATCH
         .Range("M" & rowTarget).Value = wsSource.Range("K" & matchTarget).Value  ' 2
         .Range("N" & rowTarget).Value = wsSource.Range("L" & matchTarget).Value  ' 3
         .Range("O" & rowTarget).Value = wsSource.Range("M" & matchTarget).Value  ' 4
         .Range("P" & rowTarget).Value = wsSource.Range("N" & matchTarget).Value  ' 5
         .Range("Q" & rowTarget).Value = wsSource.Range("O" & matchTarget).Value  ' 6
         .Range("R" & rowTarget).Value = wsSource.Range("P" & matchTarget).Value  ' 7
         .Range("S" & rowTarget).Value = wsSource.Range("Q" & matchTarget).Value  ' 8
         .Range("T" & rowTarget).Value = wsSource.Range("R" & matchTarget).Value  ' 9
         .Range("U" & rowTarget).Value = wsSource.Range("S" & matchTarget).Value  ' 10
         .Range("V" & rowTarget).Value = wsSource.Range("T" & matchTarget).Value  ' 11
         .Range("W" & rowTarget).Value = wsSource.Range("U" & matchTarget).Value  ' 12


         'optional source filename in the last column
         .Range("Y" & rowTarget).Value = sFile
      End With
  
      'close the source workbook, increment the output row and get the next file
      wbSource.Close SaveChanges:=False
      rowTarget = rowTarget + 1
      sFile = Dir()
   Loop
 
errHandler:
   On Error Resume Next
   Application.ScreenUpdating = True
 
   'tidy up
   Set wsSource = Nothing
   Set wbSource = Nothing
   Set wsTarget = Nothing
End Sub

 

[johnnyL]

Did you try:

matchTarget = Excel.WorksheetFunction.Match("Project Management", wsSource.Range("E1:E298"), 0)

 

[abssorb]

Thanks, yes, and a number of variations of syntax.

 

[abssorb]

Working on this today, I found if I activated the sheet before using match, the macro worked.

 ' Get Days Profile
   Set wsSource = wbSource.Worksheets("Labour forecast man days") 'EDIT IF NECESSARY
    wsSource.Activate   ' A performance hit, but without this the macro stalls on opening the source workbook
       
         matchTarget = Excel.WorksheetFunction.Match("Project Management", Range("E1:E298"), 0)  'Must be range starting with row 1 to work

 

[Fluff]

No need to activate the sheet, you can use

   Set wsSource = wbSource.Worksheets("Labour forecast man days") 'EDIT IF NECESSARY
       
         matchTarget = Application.Match("Project Management", wsSource.Range("E1:E298"), 0)  'Must be range starting with row 1 to work

 

[smozgur]

Post #5 is a more useful solution for future readers. Therefore I switched the marked solution post.

 

[johnnyL]

Doesn't Post #2 do the same thing?

 

[smozgur]

Doesn't Post #2 do the same thing?

@johnnyL: you are right. I missed the wsSource reference in your post.

Although, Application.Match VBA method would be my preferred way since it generates an error (if there is no match) that could be caught by the IsError function instead of an On Error statement that WorksheetFunction will require, your answer solves the original question. So, I switched the marked solution post once again. Thanks for letting me know.

Edit: A really nice discussion about using WorksheetFunction functions vs corresponding VBA functions and why VBA functions (where it is possible) could be preferred over the worksheet functions. Just to clarify my comment to future readers.

Application vs. Application.WorksheetFunction

I have seen both used in code when using a worksheet function in VBA, is there any difference in them?? The 2 below look like they do the same thing ?Application.Trim(" Apples Oranges ") Apples Oranges ?Application.WorksheetFunction.Trim(" Apples Oranges ") Apples Oranges

www.mrexcel.com

 

[abssorb]

Many thanks for the continued help. I tried again, but I couldn't get a result. Sorry.
In terms of helping future users, I'm happy to try more things. For me, I can continue with the activate compromise

Today I removed the activate row I added, so as to test without my 'fudge'.

#1 + activate. Re- tried my original as commented out in #1. Macro stalled. With Activate: successful

matchTarget = Excel.WorksheetFunction.Match("Project Management", Range("E1:E298"), 0)  'Must be range starting with row 1 to work

#2 was tried, without activate: Macro stalled. With Activate: successful (will use this)

matchTarget = Excel.WorksheetFunction.Match("Project Management", wsSource.Range("E1:E298"), 0)

#5 was tried, without activate: Macro stalled. With Activate: successful

matchTarget = Application.Match("Project Management", wsSource.Range("E1:E298"), 0)  'Must be range starting with row 1 to work

Excel stalls by opening the first file matching in the path. It opens the workbook, which becomes visible on the screen, it gets all the data up to the 'match' point and then simply goes no further. No error message, and if left to run for 20 mins, nothing. The macro isn't in break mode but I don't know how to test properly if it's concluded.
The source workbooks also contain their own macros, but none of them activate on opening. I'm not sure if this is relevant but I thought I'd mention it.

 

[johnnyL]

Try adding the following line of code after your 'matchTarget = ...' line of code:

Msgbox "MatchTarget is = " & matchTarget

See if that pop up box appears.