Combine 2 Loops

Sub AnalystPopData()
'Works with any number of samples, period and expriment
'Still needs entering retention time manually.
'Workup required to combine two For loops


        On Error GoTo errDesc
        Dim theAnalyst As Analyst.Application
        Dim theExploreDir As New ExploreDir
        Dim theTIC As New GraphControl
       
        Dim TempWorkbook As Workbook, analystfile As String, AnalystPath As String, strFileNames As String
        Dim xlFile As String, tempFile As String, wSheetName As String
        Dim DataPath As String
        Dim wSheet As Worksheet
        Dim theDataList As DataList
        Dim theTICGraph As GraphControl ' active Analyst TIC
        Dim theSpecGraph As Object ' spectrum to print
        Dim theTICData As FMANChromData ' data for TIC graph
        Dim theWF As FMANWiffFile ' used to count periods & expts
        Dim sampleNum As Integer ' active sample number
        
        Dim periodNum As Integer ' current period
        Dim exptNum As Integer ' current experiment
        Dim theExperiment As Experiment
        Dim theMassRange As MassRange ' MS mass range
        Dim theQstartMass As Double
        Dim theQstepmass As Double
        Dim k As Integer ' used to loop over ranges
        
        Dim arrRetentionTime() As Double
        Dim j As Integer
        Dim RetentionTime
        Dim strResponse As String
        Dim strRetTime As String
        Dim startTime As Double ' start time for spectrum
        Dim endTime As Double ' end time for spectrum
        Dim theRetentionTime As Double
        
        Dim theActivePane As Object
        Dim theDeletePane As Object
        Dim i As Integer
        
        Set theAnalyst = New Analyst.Application
        Set theExploreDir = theAnalyst.Explore
        
        'AnalystPath = InputBox("Enter the Directory Path")
        'xlFile = InputBox("Enter the File Name and Keep it Opened")
        
        AnalystPath = "E:\Analyst Data\Projects\Kombu_AA\2008\Data\071228 GRA OPT\"
        xlFile = "AA Macro.xlsm"
        tempFile = "e:\my documents\01 projects\02 AA\DataListExport.txt"
        
        Set FSO = CreateObject("Scripting.FileSystemObject")
        Set CDIR = FSO.GetFolder(AnalystPath)
                       
            SheetNumber = 1
            analystfile = Dir(AnalystPath & "*.WIFF")
            wSheetName = analystfile
            Do While analystfile <> ""
            strFileNames = strFileNames & "," & analystfile
            DataPath = AnalystPath & analystfile
            Call theExploreDir.OpenWiffFile(DataPath, 1)
            analystfile = Dir()
        
        
        ReDim arrRetentionTime(2) As Double


            For j = 0 To 1
            RetentionTime = InputBox("Enter Retention Time")
            If StrComp(UCase(RetentionTime), "NO") = 0 Then Exit Sub
            arrRetentionTime(j) = RetentionTime
            Next
 
        Set theTICGraph = theAnalyst.ActiveControl
        Set theTICData = theTICGraph.SeriesColl.Item(1).DataObject
        Set theWF = theTICData.GetWiffFileObject
        sampleNum = theTICData.GetSampleNumber
        theTICGraph.SelectionColl.RemoveAll
        For periodNum = 0 To theWF.GetActualNumberOfPeriods(sampleNum) - 1
        
        
              
        
        For exptNum = 0 To theWF.GetNumberOfExperiments(sampleNum, periodNum) - 1
        Set theExperiment = theWF.GetExperimentObject(sampleNum, periodNum, exptNum)
'        For k = 1 To theExperiment.MassRangesCount
'        Set theMassRange = theExperiment.GetMassRange(k - 1)
'        theQstartMass = Round(theMassRange.QstartMass, 2)
'        theQstepmass = Round(theMassRange.Qstepmass, 2)
'        AppActivate ("microsoft excel")
'        MsgBox "Your MRM Pair is " + Format(theQstartMass) + "/" + Format(theQstepmass)
'        Call theTICData.SetToXIC(sampleNum, periodNum, exptNum, theQstartMass, theQstepmass)
        
        For j = 0 To 1
        strRetTime = strRetTime & arrRetentionTime(j) & ","
        startTime = theRetentionTime - 0.5
        endTime = theRetentionTime + 0.5
        
        Call theTICData.SetToTIC(sampleNum, periodNum, exptNum)
        Call theTICGraph.SelectionColl.CreateAddSelection(startTime, endTime)
        theExploreDir.ShowSpectrum
        Set theSpecGraph = theAnalyst.ActiveControl
                
                theExploreDir.ListData
                Set theDataList = theAnalyst.ActiveControl
                Call theDataList.SaveListAsText(True, tempFile)
                Call theAnalyst.DeletePane(theDataList)


                Set TempWorkbook = Workbooks.Open(tempFile)
                ActiveWindow.WindowState = xlNormal
                ActiveCell.Offset(0, 0).Columns("A:D").EntireColumn.Select
                Selection.Copy
                Windows(xlFile).Activate
                Sheets(SheetNumber).Select
                ActiveCell.Columns("A:D").EntireColumn.Select
                ActiveSheet.Paste
                ActiveCell.Offset(0, 6).Range("A1").Select
                Application.CutCopyMode = False
                TempWorkbook.Close


            Set theAnalyst = New Analyst.Application
            Set theExploreDir = theAnalyst.Explore
            Set theActivePane = theAnalyst.ActiveControl
            For i = 1 To (theAnalyst.ControlCount - 1)
            If theActivePane Is theAnalyst.GetPane(1) Then
            Set theDeletePane = theAnalyst.GetPane(2)
            Else
            Set theDeletePane = theAnalyst.GetPane(1)
            End If
            Call theAnalyst.DeletePane(theDeletePane)
            Next i
'        Next k
        Next j
        Next exptNum
        Next periodNum
        
        ActiveSheet.Name = Replace(wSheetName, ".wiff", "")
        SheetNumber = SheetNumber + 1
        
        Set theTICGraph = theAnalyst.ActiveControl
        Call theAnalyst.DeletePane(theTICGraph)
               
        Loop


        MsgBox ("TASK COMPLETED!!!")


        Exit Sub
errDesc:


        MsgBox (Err.Number & Err.Description)
End Sub