[![enter image description here](https://i.stack.imgur.com/PKSzs.png)](https://i.stack.imgur.com/PKSzs.png)

[![enter image description here](https://i.stack.imgur.com/xg7gh.png)](https://i.stack.imgur.com/xg7gh.png)

From Rows 5 to 204  

Column B is just numbering the rows  

In column C Have a list of pdf file names (these are pdf certs)  

I run a bit of code and it filters the unique values from column C to column E and sorts A-Z  

Column G has the formula `=IF(E5="","",LEFT(E5,2))` to get the file index No.  

Column H has the formula `=IF(E5="","",VLOOKUP(G5+0,$I$5:$J$11,2,FALSE))` to get the file path for the folders where the certs are
Columns I & J are the Lookup table.

I put together code which will loop down the list of cert numbers in column E and then offset(0,3) to column H where the folder file-path for that cert is. It then goes to that folder copies that particular file into a folder on my desktop, then carries on down the list in column E offsetting to the file-path until it reaches the end of the cert numbers in column E, any files that are missing it highlights in red.

```vb
Sub CopyCerts() 'copying certs
    Application.ScreenUpdating = False
    Dim R As Range
    Set R = Range("E5:E204")
    Dim SourcePath As String, DestPath As String, FName As String, FileExists As String
    DestPath = "C:\Users\GaryBaker\Desktop\Certs\" 'folder to copy to

    For Each R In Range("E5", Range("E" & Rows.Count).End(xlUp)) 'Check file name in each used cell in column E
        R.Offset(0, 3).Activate
        SourcePath = ActiveCell.Value
        FileExists = Dir(SourcePath & R.Value & ".pdf") 'checking if the cert exists
        FName = Dir(SourcePath & R.Value & ".pdf") 'name of file from list in (E5:E)
        If FileExists = "" Then 'If the file does not exist highlight in red, else copy
            ActiveCell.Offset(0, -3).Font.Color = vbRed 'Highlight any Cert Nos. in range E that are missing
        Else
            FileCopy SourcePath & FName, DestPath & FName 'Copy the file
        End If
        Do While FName <> "" 'Loop while files found
            FName = Dir() 'Search the next file
        Loop
    Next
    MsgBox ("files copied")
    Application.ScreenUpdating = True
End Sub

```

I need to modify the code so it will search the subfolders of each main folder as well.

I had several attempts to cobble together some code. I keep getting errors “For without Next”, “Block if without end if”, End if without Block if” etc.

```vb
Sub CopyCertsSubFolders() 'copying certs
    Application.ScreenUpdating = False
    Dim R As Range
    Set R = Range("E5:E204")
    Dim SourcePath As String, DestPath As String, FName As String, FileExists As String, FSO As Object, fld As Object, FSOFile As Object, fsoFol As Object
    DestPath = "C:\Users\GaryBaker\Desktop\Certs\" 'folder to copy to

    If Right(SourcePath, 1) <> "\" Then
        SourcePath = SourcePath & "\"
    End If

    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set fld = FSO.GetFolder(SourcePath)
    If FSO.FolderExists(fld) Then
    End If
    'For Each fsoFol In FSO.GetFolder(SourcePath).subfolders
    'For Each FSOFile In fsoFol.Files

    For Each R In Range("E5", Range("E" & Rows.Count).End(xlUp)) 'Check file name in each used cell in column E
        R.Offset(0, 3).Activate
        SourcePath = ActiveCell.Value
        FileExists = Dir(SourcePath & subfolders & R.Value & ".pdf") 'checking if the cert exists in folders & sub-folders
        FName = Dir(SourcePath & subfolders & R.Value & ".pdf") 'name of file from list in (E5:E)

        If FileExists = "" Then 'If the file does not exist highlight in red, else copy
            ActiveCell.Offset(0, -3).Font.Color = vbRed 'Highlight any Cert Nos. in range E that are missing
        Else
            FileCopy SourcePath & FName, DestPath & FName 'Copy the file
        End If

        Do While FName <> "" 'Loop while files found
            FName = Dir() 'Search the next file
        Loop
    Next
    MsgBox ("files copied")
    Application.ScreenUpdating = True
End Sub

```