I am trying to write a code that will loop through 2 different arrays. The first loop works fine however when I get to the second loop the second array does not read the information form the first array. Can Anyone help me please. Please see code below.

Sub BackEndScanningProject()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

For X = 1 To 13

Dim PathEntry$, W%
Dim sPath$
Dim FSO, MainFile As Object
Dim FileName As String
Dim FS, SubFldr, LittleFolder, MainFolder

If X = 1 Then SubFoldername = "C:\Any Old Folder\\Qtr 1 - 2002"
If X = 2 Then SubFoldername = "C:\Any Old Folder\\Qtr 2 - 2002"
If X = 3 Then SubFoldername = "C:\Any Old Folder\\Qtr 3 - 2002"
If X = 4 Then SubFoldername = "C:\Any Old Folder\\Qtr 4 - 2002"
If X = 5 Then SubFoldername = "C:\Any Old Folder\\Qtr 1 - 2003"
If X = 6 Then SubFoldername = "C:\Any Old Folder\\Qtr 2 - 2003"
If X = 7 Then SubFoldername = "C:\Any Old Folder\\Qtr 3 - 2003"
If X = 8 Then SubFoldername = "C:\Any Old Folder\\Qtr 4 - 2003"
If X = 9 Then SubFoldername = "C:\Any Old Folder\\Qtr 1 - 2004"
If X = 10 Then SubFoldername = "C:\Any Old Folder\\Qtr 2 - 2004"
If X = 11 Then SubFoldername = "C:\Any Old Folder\\Qtr 3 - 2004"
If X = 12 Then SubFoldername = "C:\Any Old Folder\\Qtr 4 - 2004"
If X = 13 Then SubFoldername = "C:\Any Old Folder\\Qtr 3_4 - 2001"


Set FSO = CreateObject("Scripting.FileSystemObject")
Set SubFldr = FS.GetFolder(SubFoldername)
Set MainFolder = SubFldr.SubFolders
ReDim Test(Z) As Variant
Dim SpongeBob As String

For Each LittleFolder In MainFolder
Z = Z + 1

ReDim Preserve Test(Z)

Test(Z) = LittleFolder

Next

For FolderPath = 1 To UBound(Test())

OP = Test(FolderPath)

Set FSO1 = CreateObject("Scripting.FileSystemObject")
Set g = FSO1.GetFolder(OP)
Set gc = g.SubFolders
Dim AnotherName() As Variant

For Each g1 In gc
V = V + 1

ReDim Preserve AnotherName(V)

AnotherName(V) = g1
Next

If V = Empty Then GoTo BoBo

For FolderPath1 = 1 To UBound(AnotherName)

PathName = AnotherName(FolderPath1)

Workbooks.Add

[A1] = "File Path"
[B1] = "Title / Keywords"
[C1] = "File Type"
[D1] = "File Size"
[E1] = "Date Created"
[f1] = "Date Last Accessed"
[g1] = "Date Last Modified"

Rows("1:1").Select

With Selection
.Font.Name = "Tahoma"
.Font.FontStyle = "Regular"
.Font.Size = 12
.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With

sPath$ = PathName

PathEntry = Dir(sPath & "\*.*", vbNormal + vbHidden)

FileName = sPath & "\" & PathEntry

W = 1

While Len(PathEntry)

If PathEntry <> "." And PathEntry <> ".." Then

If LCase(Mid(PathEntry, InStr(1, PathEntry, ".") + 1)) = "pdf" Then

W = W + 1

If W = "65536" Then
Sheets.Add

W = 1

[A1] = "File Path"
[B1] = "Title / Keywords"
[C1] = "File Type"
[D1] = "File Size"
[E1] = "Date Created"
[f1] = "Date Last Accessed"
[g1] = "Date Last Modified"

Rows("1:1").Select

With Selection
.Font.Name = "Tahoma"
.Font.FontStyle = "Regular"
.Font.Size = 12
.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With

End If

Set MainFile = FSO.GetFile(FileName)
Cells(W, 1) = sPath
Cells(W, 2) = PdfTitle(sPath, PathEntry)
Cells(W, 3).Formula = MainFile.Type
Cells(W, 4).Formula = MainFile.Size
Cells(W, 5).Formula = MainFile.DateCreated
Cells(W, 6).Formula = MainFile.DateLastAccessed
Cells(W, 7).Formula = MainFile.DatelastModified

End If

PathEntry = Dir()

End If

Wend

Cells.Select

Columns.AutoFit

Bob = Mid(PathName, 31)

Bob = Replace(Bob, "\", " - ") & ".xls"

ActiveWorkbook.SaveAs "C\Folder Where I save the results\Excel Data Files" & "\" & Bob

ActiveWorkbook.Close

Next FolderPath1



BoBo:

Next FolderPath


Next X


End Sub

Private Function PdfTitle$(iPath$, iFile$)

With CreateObject("Shell.Application").Namespace(CStr(iPath))
PdfTitle = .GetDetailsOf(.ParseName(iFile), 10)
End With