VBA Loop through files in a folder with certain filename

Question

I have managed to develop this code slowly into something that is usable but isn't quite there yet. I am new to VBA and the code below so far does the following:

• Loops through workbooks in a folder
• Copies certain cells from each workbook
• Pastes those cells into rows with information organised by column
• Copies a range from each workbook

• Pastes the range (14 rows of data) beside the single rows of data formed by the single cells from each workbook (effectively creating two halves to a worksheet - one half with each single row of data belonging to a certain workbook (Columns A:E) and the other half with each range of 14 rows belonging to a certain workbook (Columns F:M))

• All of the above is only carried out if the workbook in the folder has NOT already been looped (this is done via a function)

  • This function looks at a column of filenames that is created by previously running the code - meaning that the filename of each looped workbook is recorded in the list created by the code and the code only copies data from workbooks with a filename that is not already included in the list.

---

The next development of the code that I have been working on and I need help with is adding another condition - I.e making the code only look at files that have not been looped previously AND also only at files with a certain filename-ending, within the group of not looped workbooks.

My logic in how to achieve this was to add another function just like the looped function and modify the code within it to look at the first three characters of a name that is entered in a cell and find/compare it to the not already looped filenames (the filename-ending (its last 3 characters) is always the first three characters of a name).

This is the main code and function:

Sub CopyFromFolderExample()

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets(1)
Dim strFolder As String, strFile As String, r As Long, wb As Workbook
Dim varTemp(1 To 5) As Variant, r1 As Long, r3 As Range

Application.ScreenUpdating = False
strFolder = "D:\Other\folder\"
strFile = Dir(strFolder & "*.xl*")

Do While Len(strFile) > 0
    If Not Looped(strFile, ws) Then
        Application.StatusBar = "Reading data from " & strFile & "..."
        Set wb = Workbooks.Add(strFolder & strFile)
        With wb.Worksheets(1)
            varTemp(1) = strFile
            varTemp(2) = .Range("A13").Value
            varTemp(3) = .Range("H8").Value
            varTemp(4) = .Range("H9").Value
            varTemp(5) = .Range("H37").Value
            Set r3 = .Range("A20:H33")
        End With
        With ws
            r = .Range("A" & .Rows.Count).End(xlUp).Row + 1
            r1 = .Range("F" & .Rows.Count).End(xlUp).Row + 1 'last used row in col F
            .Range(.Cells(r, 1), .Cells(r, 5)).Value = varTemp
            .Cells(r1, 6).Resize(r3.Rows.Count, r3.Columns.Count).Value = r3.Value 'transfer A20:H33
        End With
        wb.Close False
    End If
  strFile = Dir
Loop

Application.StatusBar = False
Application.ScreenUpdating = True

End Sub

---

Private Function Looped(strFile As String, ws As Worksheet) As Boolean

    Dim Found As Range
    Set Found = ws.Range("A:A").Find(strFile)

    If Found Is Nothing Then
        Looped = False
    Else
        Looped = True
    End If

    End Function

This is the modified function that I have been trying to use by adding another IFstatement into the code - unsuccessfully:

Private Function notx(strFile As String, ws As Worksheet) As Boolean

Dim Found As Range
Set Found = strFile.Find(Left(ws.Range("P1").Value, 3))

If Found Is Nothing Then
    notx = False
Else
    notx = True
End If

End Function

Answer 1

Your strFile is a string and you cannot use .Find in a string. Try changing your notx function to something like:

Private Function notx(strFile As String, ws As Worksheet) As Boolean

Dim Found As Integer
Found = InStr(1, strFile, Left(ws.Range("P1").Value, 3))

If Found = 0 Then
    notx = False
Else
    notx = True
End If

End Function