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(i Path))
PdfTitle = .GetDetailsOf(.ParseName(iFile), 10)
End With


--
NSKearns
------------------------------------------------------------------------
NSKearns's Profile: http://www.excelforum.com/member.php...o&userid=36948
View this thread: http://www.excelforum.com/showthread...hreadid=572545