VBA nested Loop flow control

Posted by PCGIZMO on Stack Overflow See other posts from Stack Overflow or by PCGIZMO
Published on 2012-07-09T20:55:07Z Indexed on 2012/07/09 21:15 UTC
Read the original article Hit count: 346

Filed under:
|
|
|

I will be brief and stick to what I know. This code for the most part works as it should. The only issue is in the iteration of the x and z loop. these to loops should set the range and yLABEL for the Y loop. I can get through a set and come up with the correct range after that things go bonkers. I know some of it has to do with not breaking out of x to set z and then back to x update the range.

It should work z is found then x. the range between them is set for y. then next x but y stays then rang between y and x is set for y.. so on and so forth kinda like a slinky down the stairs. or a slide rule depending on how I set the loops either way I end up all over the place after a couple iterations.

I have done a few things but each time I break out of x to set z , X restarts at the top of the range. At least that's what I think I am seeing. In the example sheet i have since changed the way the way the offset works with the loop but the idea is still the same. I have goto statements at this time i was going to try figuring out conditional switches after the loops were working. Any help direction or advice is appreciated.

Example of worksheets

Option Explicit

Sub parse()

            Application.DisplayAlerts = False
                'Application.EnableCancelKey = xlDisabled

            Dim strPath As String, strPathused As String
            strPath = "C:\clerk plan2"

            Dim objfso As FileSystemObject, objFolder As Folder, objfile As Object

            Set objfso = CreateObject("Scripting.FileSystemObject")
            Set objFolder = objfso.GetFolder(strPath)

    'Loop through objWorkBooks
For Each objfile In objFolder.Files

        If objfso.GetExtensionName(objfile.Path) = "xlsx" Then

            Dim objWorkbook As Workbook
            Set objWorkbook = Workbooks.Open(objfile.Path)

            ' Set path for move to at end of script
            strPathused = "C:\prodplan\used\" & objWorkbook.Name
            objWorkbook.Worksheets("inbound transfer sheet").Activate
            objWorkbook.Worksheets("inbound transfer sheet").Cells.UnMerge

            'Range management WB
            Dim SRCwb As Worksheet, SRCrange1 As Range, SRCrange2 As Range, lastrow As Range

            Set SRCwb = objWorkbook.Worksheets("inbound transfer sheet")
            Set SRCrange1 = SRCwb.Range("g3:g150")
            Set SRCrange2 = SRCwb.Range("a1:a150")


            Dim DSTws As Worksheet
            Set DSTws = Workbooks("clerkplan2.xlsm").Worksheets("transfer")


            Dim STR1 As String, STR2 As String, xVAL As String, zVAL As String, xSTR As String, zSTR As String

            STR1 = "INBOUND TRANS"
            STR2 = "INBOUND CA TRANS"

            Dim x As Variant, z As Variant, y As Variant, zxRANGE As Range
 For Each z In SRCrange2
        zSTR = Mid(z, 1, 16)
        If zSTR <> STR2 Then GoTo zNEXT
         If zSTR = STR2 Then
            zVAL = z
        End If

For Each x In SRCrange2
        xSTR = Mid(x, 1, 13)
        If xSTR <> STR1 Then GoTo xNEXT
         If xSTR = STR1 Then
            xVAL = x
       End If

           Dim yLABEL As String

        If xVAL = x And zVAL = z Then
         If x.Row > z.Row Then
            Set zxRANGE = SRCwb.Range(x.Offset(1, 0).Address & " : " & z.Offset(-1, 0).Address)
            yLABEL = z.Value
       Else
            Set zxRANGE = SRCwb.Range(z.Offset(-1, 0).Address & " : " & x.Offset(1, 0).Address)
            yLABEL = x.Value
         End If
       End If
                                        MsgBox zxRANGE.Address ' DEBUG
For Each y In zxRANGE


        If y.Offset(0, 6) = "Temp" Or y.Offset(0, 14) = "Begin Time" Or y.Offset(0, 15) = "End Time" Or _
            Len(y.Offset(0, 6)) = 0 Or Len(y.Offset(0, 14)) = 0 Or Len(y.Offset(0, 15)) = "0" Then yNEXT


            Set lastrow = Workbooks("clerkplan2.xlsm").Worksheets("transfer").Range("c" & DSTws.Rows.Count).End(xlUp).Offset(1, 0)
            y.Offset(0, 6).Copy
            lastrow.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=True, Transpose:=False
            DSTws.Activate
            ActiveCell.Offset(0, -1) = objWorkbook.Name
            ActiveCell.Offset(0, -2) = yLABEL

            objWorkbook.Activate
            y.Offset(0, 14).Copy
            Set lastrow = Workbooks("clerkplan2.xlsm").Worksheets("transfer").Range("d" & DSTws.Rows.Count).End(xlUp).Offset(1, 0)
            lastrow.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=True, Transpose:=False

            objWorkbook.Activate
            y.Offset(0, 15).Copy
            Set lastrow = Workbooks("clerkplan2.xlsm").Worksheets("transfer").Range("e" & DSTws.Rows.Count).End(xlUp).Offset(1, 0)
            lastrow.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=True, Transpose:=False

yNEXT:
    Next y
xNEXT:
    Next x
zNEXT:
    Next z

            strPathused = "C:\clerk plan2\used\" & objWorkbook.Name


            objWorkbook.Close False
                                'Move proccesed file to new Dir

                    Dim OldFilePath As String
                    Dim NewFilePath As String

                OldFilePath = objfile 'original file location
                NewFilePath = strPathused ' new file location
                Name OldFilePath As NewFilePath ' move the file




        End If

    Next

End Sub

© Stack Overflow or respective owner

Related posts about vba

Related posts about loops