VBA: Pulling data from files in the folder & skipping already processed ones

Hi all,

I adjusted the code I found on the Internet to pull data from the files in the folder and put them in one master sheet.
However, the numer of files will grow very quickly every week, so for that reason I would like to implement in the code that macro will skip the files that were already processed. I would like to do it by the looking up the file name in the master sheet (column U).
Please find the code below:

Code:

---

Option Explicit


Const FOLDER_PATH = "Z:\...\...\...\"  'REMEMBER END BACKSLASH


Sub ImportWorksheets()
  '=============================================
  'Process all Excel files in specified folder
  '=============================================
  Dim sFile As String          'file to process
  Dim fName As String
  Dim wsTarget As Worksheet
  Dim wbSource As Workbook
  Dim wsSource As Worksheet
  Dim rowTarget As Long        'output row
  Dim wsMaster As Worksheet
  Dim NR As Long
  rowTarget = 3

  'Setup
    Application.ScreenUpdating = False  'speed up macro execution
    Application.EnableEvents = False    'turn off other macros for now
    Application.DisplayAlerts = False  'turn off system messages for now

    Set wsMaster = ThisWorkbook.Sheets("Arkusz1")    'sheet report is built into

With wsMaster
    If MsgBox("Clear the old data first?", vbYesNo) = vbYes Then
        .UsedRange.Offset(2).Columns(3).Clear
        .UsedRange.Offset(2).Columns(4).Clear
        .UsedRange.Offset(2).Columns(5).Clear
        .UsedRange.Offset(2).Columns(6).Clear
        .UsedRange.Offset(2).Columns(7).Clear
        .UsedRange.Offset(2).Columns(8).Clear
        .UsedRange.Offset(2).Columns(9).Clear
        .UsedRange.Offset(2).Columns(10).Clear
        .UsedRange.Offset(2).Columns(11).Clear
        .UsedRange.Offset(2).Columns(12).Clear
        .UsedRange.Offset(2).Columns(13).Clear
        .UsedRange.Offset(2).Columns(14).Clear
        .UsedRange.Offset(2).Columns(15).Clear
        .UsedRange.Offset(2).Columns(17).Clear
        .UsedRange.Offset(2).Columns(18).Clear
        .UsedRange.Offset(2).Columns(20).Clear
        NR = 3

    Else
        NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1    'appends data to existing data
    End If

  '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("Arkusz1")

  'loop through the Excel files in the folder
  sFile = Dir(FOLDER_PATH & "*.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(3) 'EDIT IF NECESSARY

      'import the data
      With wsTarget
        .Range("C" & rowTarget).Value = wsSource.Range("F4").Value
        .Range("D" & rowTarget).Value = wsSource.Range("J4").Value
        .Range("E" & rowTarget).Value = wsSource.Range("J7").Value
        .Range("F" & rowTarget).Value = wsSource.Range("J10").Value
        .Range("G" & rowTarget).Value = wsSource.Range("J19").Value
        .Range("H" & rowTarget).Value = wsSource.Range("L19").Value
        .Range("I" & rowTarget).Value = wsSource.Range("H17").Value
        .Range("J" & rowTarget).Value = wsSource.Range("N27").Value
        .Range("K" & rowTarget).Value = wsSource.Range("N29").Value
        .Range("L" & rowTarget).Value = wsSource.Range("N36").Value
        .Range("M" & rowTarget).Value = wsSource.Range("N38").Value
        .Range("N" & rowTarget).Value = wsSource.Range("J50").Value
        .Range("O" & rowTarget).Value = wsSource.Range("L50").Value
        .Range("Q" & rowTarget).Value = wsSource.Range("J52").Value
        .Range("R" & rowTarget).Value = wsSource.Range("L52").Value
        .Range("T" & rowTarget).Value = wsSource.Range("N57").Value

        'optional source filename in the last column
        .Range("U" & 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
  End If

  'Format columns to the desired format
  .UsedRange.Offset(2).Columns(7).NumberFormat = "### ### ##0"
  .UsedRange.Offset(2).Columns(8).NumberFormat = "### ### ##0"
  .UsedRange.Offset(2).Columns(9).NumberFormat = "#,##0.00 $"
  .UsedRange.Offset(2).Columns(10).NumberFormat = "#,##0.00 $"
  .UsedRange.Offset(2).Columns(11).NumberFormat = "#,##0.00 $"
  .UsedRange.Offset(2).Columns(12).NumberFormat = "#,##0.00 $"
  .UsedRange.Offset(2).Columns(13).NumberFormat = "#,##0.00 $"
  .UsedRange.Offset(2).Columns(14).NumberFormat = "0.00%"
  .UsedRange.Offset(2).Columns(15).NumberFormat = "0.00%"
  .UsedRange.Offset(2).Columns(16).NumberFormat = "0.00%"
  .UsedRange.Offset(2).Columns(17).NumberFormat = "0.00%"
  .UsedRange.Offset(2).Columns(18).NumberFormat = "0.00%"
  .UsedRange.Offset(2).Columns(19).NumberFormat = "0.00%"
  .UsedRange.Offset(2).Columns(20).NumberFormat = "0.00%"

errHandler:
  On Error Resume Next
  Application.ScreenUpdating = True

  'tidy up
  Set wsSource = Nothing
  Set wbSource = Nothing
  Set wsTarget = Nothing
End With
End Sub




Private Function FileFolderExists(strPath As String) As Boolean
    If Not Dir(strPath, vbDirectory) = vbNullString Then FileFolderExists = True
End Function

---

Thanks in advance!

Where does the variable "rowtarget" gets his first value ? (saw it, sorry, it's 3) Didn't you want to use NR instead ?

For your problem you could place a filter on row U where sfile is the thing you are looking for.

With .specialcells.visible you could count no of cells visible. If the filter has a row (= file already imported, if unique naming convention was followed), the visible cells of the search range would be greater than 1 (or number of columns you have -- not sure about that one ---)

Charlize

This is an example of a theoretical sheet where you look for stuff in column A between rows 1 to 3000
You look for the string myfilename => replace with sfile (without quotes) in certain range and result gives range lookup
if range lookup is empty = nothing found

Code:

---

Sub Check_file_already_imported()
'Declare the lookup range (colum and number of rows)
'here A1 to A3000
Dim lookup As Range
'look for myfilename = string
'in your case sfile
Set lookup = Worksheets(1).Range("A1:A3000").Find("myfilename", LookIn:=xlValues)
'if nothing found, you still need to to something with it
If Not lookup Is Nothing Then
    MsgBox "File has been found on row : " & _
            Worksheets(1).Range("A1:A3000").Find("myfilename", LookIn:=xlValues).Address & _
            " so already been processed."
Else
    MsgBox "The file hasn't been processed yet."
End If
End Sub

---

Charlize