Stuck in an error Loop

A

anichols

Board Regular
Joined
Mar 11, 2021
Messages
87
Office Version
  1. 365
Platform
  1. Windows
Hello All,

I tried to do a loop that would write an entry to an error log sheet in the event a folder couldn't be created or already existed, but I haven't done it well, and continue to endlessly generate errors. If someone has any insight into where I went wrong, or suggestions on a more elegant way of approaching this, I would greatly appreciate it!

VBA Code: 
Sub CreateTheMonthlyFolders()

    Dim Lastrow As Long
    Dim fRow As Long
    Dim fRowv As Long
    Dim ws As Worksheet
    Dim fPath As String
    On Error GoTo err
    
    Set ws = ThisWorkbook.Sheets("FOLDERStest")

    With ws
        Lastrow = .Range("B" & Rows.Count).End(xlUp).Row
        fRowv = ThisWorkbook.Sheets("FOLDERStest").Range("Z1").Value
        For fRow = fRowv To Lastrow
            
            If .Range("B" & fRow).Value <> "" Then
                fPath = .Range("D" & fRow) & .Range("E" & fRow)
                MkDir fPath
                fRowv = fRowv + 1
            Else
                If fRow > Lastrow Then
                    ThisWorkbook.Sheets("FOLDERStest").Range("Z1").Value = 5
                    MsgBox "loop ended"
                    Exit Sub
                End If
            End If
        Next fRow
    End With
err:
        MsgBox "error " & fRow & ". last row is " & Lastrow & ". fRow is " & fRow
        fRowv = fRowv + 1
        ThisWorkbook.Sheets("FOLDERStest").Range("Z1").Value = fRowv
        Call ErrorLog
        Call CreateTheMonthlyFolders
End Sub

Just in case here's the error log code:
VBA Code: 
Sub ErrorLog()
Dim Lastrow As Long
Sheets("ErrorLOG").Select
Lastrow = Range("B" & Rows.Count).End(xlUp).Row
Range("B" & Lastrow).Offset(1, 0).Select
    ActiveCell.FormulaR1C1 = "=NOW()"
    ActiveCell.Copy
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Sheets("FOLDERStest").Select
    Range("Z1").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("ErrorLOG").Select
    Range("B" & Lastrow).Offset(1, 1).Select
    ActiveSheet.Paste
End Sub
 

Excel Facts

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.
Sort by date Sort by votes
Add a line of code before your label. Otherwise your code will always execute the error code at the end of the sub.


Rich (BB code): 
    End With
   
    Exit Sub

err:
        MsgBox "error " & fRow & ". last row is " & Lastrow & ". fRow is " & fRow
 
Upvote 0
6StringJazzer said:
Add a line of code before your label. Otherwise your code will always execute the error code at the end of the sub.


Rich (BB code): 
    End With
  
    Exit Sub

err:
        MsgBox "error " & fRow & ". last row is " & Lastrow & ". fRow is " & fRow
Click to expand...
Thanks, It does still seem to loop when there are actual errors though. If no errors are present it does stop the initial loop.
 
Upvote 0
I didn't notice it the first time but your Sub has a recursive call to itself as the last line when an error occurs. That will cause endless recursion and probably the cause of the "loop." What is your purpose in doing that?
 
Upvote 0
I'm sure there is a better way to accomplish my goal, but basically, The idea behind the code was to loop through the list of file paths and skip the blank rows until the end of the population. In the event of an error I was wanting to log the error line and then skip and continue the run.
 
Upvote 0
anichols said:
I'm sure there is a better way to accomplish my goal, but basically, The idea behind the code was to loop through the list of file paths and skip the blank rows until the end of the population. In the event of an error I was wanting to log the error line and then skip and continue the run.
Click to expand...

Your code needs to handle the expected error (75) & pass the values as arguments to your error log procedure

untested but see if this update to both your codes helps

VBA Code: 
Sub CreateTheMonthlyFolders()
    
    Dim fPath           As String
    Dim Lastrow         As Long, fRow As Long, fRowv As Long
    Dim wsFOLDERStest   As Worksheet
    
    On Error GoTo myerror
    
    Set wsFOLDERStest = ThisWorkbook.Sheets("FOLDERStest")
    
    With wsFOLDERStest
        Lastrow = .Range("B" & .Rows.Count).End(xlUp).Row
        fRowv = .Range("Z1").Value
        
        For fRow = fRowv To Lastrow
            
            If fRow > Lastrow Then
            
                .Range("Z1").Value = 5
                'inform user
                err.Raise 600, , "loop ended"
                  
            ElseIf .Range("B" & fRow).Value <> "" Then
                
                fPath = .Range("D" & fRow) & .Range("E" & fRow)
                
                MkDir fPath
                
            End If
nextrow:
        Next fRow
    End With
    
myerror:
    If err <> 0 Then
        If err.Number = 75 Then
            'path / file error
            MsgBox "error " & fRow & ". last row Is " & Lastrow & ". fRow Is " & fRow
            'log error
            Call ErrorLog(fPath, fRow)
            'next file path
            Resume nextrow
        Else
            'all other errors
            MsgBox (Error(err)), 48, "Error"
        End If
    End If
    
End Sub

VBA Code: 
Sub ErrorLog(ByVal FolderPath As String, ByVal RecordRow As Long)
    Dim lr          As Long
    Dim wsErrorLog  As Worksheet
    
    Set wsErrorLog = ThisWorkbook.Worksheets("ErrorLOG")
    
    With wsErrorLog
    lr = .Range("B" & .Rows.Count).End(xlUp).Row + 1
       .Cells(lr, 1).Value = FolderPath
       .Cells(lr, 2).FormulaR1C1 = "=NOW()"
       .Cells(lr, 3).Value = RecordRow
    End With
    
End Sub
 
Upvote 0
Solution
dmt32 said:
Your code needs to handle the expected error (75) & pass the values as arguments to your error log procedure

untested but see if this update to both your codes helps

VBA Code: 
Sub CreateTheMonthlyFolders()
   
    Dim fPath           As String
    Dim Lastrow         As Long, fRow As Long, fRowv As Long
    Dim wsFOLDERStest   As Worksheet
   
    On Error GoTo myerror
   
    Set wsFOLDERStest = ThisWorkbook.Sheets("FOLDERStest")
   
    With wsFOLDERStest
        Lastrow = .Range("B" & .Rows.Count).End(xlUp).Row
        fRowv = .Range("Z1").Value
       
        For fRow = fRowv To Lastrow
           
            If fRow > Lastrow Then
           
                .Range("Z1").Value = 5
                'inform user
                err.Raise 600, , "loop ended"
                 
            ElseIf .Range("B" & fRow).Value <> "" Then
               
                fPath = .Range("D" & fRow) & .Range("E" & fRow)
               
                MkDir fPath
               
            End If
nextrow:
        Next fRow
    End With
   
myerror:
    If err <> 0 Then
        If err.Number = 75 Then
            'path / file error
            MsgBox "error " & fRow & ". last row Is " & Lastrow & ". fRow Is " & fRow
            'log error
            Call ErrorLog(fPath, fRow)
            'next file path
            Resume nextrow
        Else
            'all other errors
            MsgBox (Error(err)), 48, "Error"
        End If
    End If
   
End Sub

VBA Code: 
Sub ErrorLog(ByVal FolderPath As String, ByVal RecordRow As Long)
    Dim lr          As Long
    Dim wsErrorLog  As Worksheet
   
    Set wsErrorLog = ThisWorkbook.Worksheets("ErrorLOG")
   
    With wsErrorLog
    lr = .Range("B" & .Rows.Count).End(xlUp).Row + 1
       .Cells(lr, 1).Value = FolderPath
       .Cells(lr, 2).FormulaR1C1 = "=NOW()"
       .Cells(lr, 3).Value = RecordRow
    End With
   
End Sub
Click to expand...
Awesome thank you!

For my future knowledge - Using resume will allow the loop to continue even if it breaks due to error?
And what is this doing? (ByVal FolderPath As String, ByVal RecordRow As Long)

Thank you!
 
Upvote 0
anichols said:
Awesome thank you!

For my future knowledge - Using resume will allow the loop to continue even if it breaks due to error?
Click to expand...
Resume - clears the error & code resumes at the line specified in the Line argument (nextrow)
anichols said:
And what is this doing? (ByVal FolderPath As String, ByVal RecordRow As Long)
Click to expand...
a brief explanation:

When code inside a subroutine needs information passed to it you do this by adding parameters to the declaration allowing you to pass in arguments.
A variable passed from a calling procedure to a subroutine is called an argument.
It is good practice for procedures that use arguments to define their data type otherwise they will be variants. Data that is passed as the argument must match the data type defined for that argument.

You pass variables in one of two ways ByVal or ByRef

ByRef - address to the object is passed (any changes made in subroutine will be passed back to calling procedure)
ByVal - just a copy of the address to the object is passed. (any changes made in subroutine will not show in the calling procedure)

Default is ByRef but unless you really need changes in your subroutine to be reflected in the calling procedure then for most cases, I would suggest they are passed ByVal

To understand in more detail suggest search web for "passing values to sub"

Dave
 
Upvote 0
dmt32 said:
Resume - clears the error & code resumes at the line specified in the Line argument (nextrow)

a brief explanation:

When code inside a subroutine needs information passed to it you do this by adding parameters to the declaration allowing you to pass in arguments.
A variable passed from a calling procedure to a subroutine is called an argument.
It is good practice for procedures that use arguments to define their data type otherwise they will be variants. Data that is passed as the argument must match the data type defined for that argument.

You pass variables in one of two ways ByVal or ByRef

ByRef - address to the object is passed (any changes made in subroutine will be passed back to calling procedure)
ByVal - just a copy of the address to the object is passed. (any changes made in subroutine will not show in the calling procedure)

Default is ByRef but unless you really need changes in your subroutine to be reflected in the calling procedure then for most cases, I would suggest they are passed ByVal

To understand in more detail suggest search web for "passing values to sub"

Dave
Click to expand...
Awesome! Thank you for your assistance and explanation. I've learned something new today!
 
Upvote 0
You must log in or register to reply here.

Similar threads

G
  • Solved
If Else Loop macro running slow, anyway to speed it up?
Replies
9
Views
265
Alex Blakenburg
A
G
  • Solved
Stop excel macro from running if there is a blank cell in a column
Replies
5
Views
475
RobP
R
D
  • Solved
Error 1004
2
Replies
18
Views
319
dmt32
D
A
  • Solved
Looping a MkDir function
Replies
2
Views
414
anichols
A
M
  • Question Question
VBA Subtotal 47,000+ Rows
Replies
1
Views
206
igold
igold

Forum statistics

Threads
1,223,703
Messages
6,173,977
Members
452,540
Latest member
haasro02

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top