Loop a function that runs on files in a folder

Question

I have a macro that is to be used inside a macro I found on internet.

The second macro runs through all Excel files inside a folder:

Sub RunOnAllFilesInFolder()
    Dim folderName As String, eApp As Excel.Application, fileName As String
    Dim wb As Workbook, ws As Worksheet, currWs As Worksheet, currWb As Workbook
    Dim fDialog As Object: Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
    Set currWb = ActiveWorkbook: Set currWs = ActiveSheet

    'Select folder in which all files are stored
    fDialog.Title = "Select a folder"
    fDialog.InitialFileName = currWb.Path
    If fDialog.Show = -1 Then
        folderName = fDialog.SelectedItems(1)
    End If

    'Create a separate Excel process that is invisibile
    Set eApp = New Excel.Application:  eApp.Visible = False

    'Search for all files in folder [replace *.* with your pattern e.g. *.xlsx]
    fileName = Dir(folderName & "\*.*")
    Do While fileName <> ""
        'Update status bar to indicate progress
        Application.StatusBar = "Processing " & folderName & "\" & fileName

        Set wb = eApp.Workbooks.Open(folderName & "\" & fileName)
        '...
        'YOUR CODE HERE
        '...
        wb.Close SaveChanges:=False 'Close opened worbook w/o saving, change as needed
        Debug.Print "Processed " & folderName & "\" & fileName 
        fileName = Dir()
    Loop
    eApp.Quit
    Set eApp = Nothing
    'Clear statusbar and notify of macro completion
    Application.StatusBar = ""
    MsgBox "Completed executing macro on all workbooks"
End Sub

I made a macro that, based on three named cells in a file, finds the ranges and change the style of some other ranges.

Not all Excel files have all three named cells, so I need the code to work when the range is not valid.

I tried to use error handlers but I received the following error:

"Loop without Do"

I tried IF and else for when the range does not exist and also found errors.

My code:

Dim test As Worksheet
Dim rOutstandingR As Range
Dim rAdditionalDueR As Range
Dim rFollowingR As Range
Dim rOutstandingBorderR As Range
Dim rAdditionalDueBorderR As Range
Dim rFollowingBorderR As Range
Dim ORow As Long
Dim OCol As Long
Dim ARow As Long
Dim ACol As Long
Dim FRow As Long
Dim FCol As Long
Dim OutstandingTopBorderRange As Range
Dim OutstandingBottomBorderRange As Range
Dim OutstandingRightBorderRange As Range
Dim AdditionalDueTopBorderRange As Range
Dim AdditionalDueBottomRange As Range
Dim AdditinalDueRightBorderRange As Range
Dim FollowingTopBorderRange As Range
Dim FollowingBottomBorderRange As Range
Dim FollowingRightBorderRange As Range
Dim OutstandingTextRange As Range
Dim AdditionalDueTextRange As Range
Dim FollowingTextRange

With Range("A1:Z999")

    'Setting up another range that may not exists within excel file and give an error 

    Set rOutstandingR = ActiveSheet.Range("Outstanding")
    rOutstandingBorderR = rOutstandingR.Address
    rOutstandingR.Select

‘more code in which I change format of cells based on range

    'Setting up another range that may not exists within excel file and give an error  

    Set rAdditionalDueR = ActiveSheet.Range("AdditionalDue")
    rAdditionalDueBorderR = rAdditionalDueR.Address
    rAdditionalDueR.Select

‘more code in which I change format of cells based on range

'Setting up another range that may not exists within excel file and give an error    
    'Setting Up rFollowingR  as Range for Following Variable
    Set rFollowingR = ActiveSheet.Range("Following")
    rFollowingBorderR = rFollowingR.Address
    rFollowingR.Select

‘more code in which I change format of cells based on range

As you can imagine by the amount of ranges, there is a lot of code in between but it's only based on the three major ranges for the named cells "Outstanding", "AdditionalDue" and "Following".

I need that all the codes between ranges work and if the first range doesn't exist goes to validate then next and do the changes of format, etcetera.

I tried to put some error handlers (resume labels) but I wasn't able to fix it when I used the code above within the first macro due to the loop through all the files.

How can I put the error handlers so I could use this macro inside the one that runs over a folder of files.

Answer 1

There are two ways to handle this, however with the snippets provided it's not straightforward to test what you're working on. You may want to consider separating your code into multiple subs/functions.

This solution should be clean assuming that you want some type of handling code to run:

With range("A1:Z999")

    'Setting up another range that may not exists within excel file and give an error
    On Error GoTo OutstandingError

    Set rOutstandingR = ActiveSheet.range("Outstanding")
    rOutstandingBorderR = rOutstandingR.Address
    rOutstandingR.Select

OutstandingResume:

    'more code in which I change format of cells based on range

    'Setting up another range that may not exists within excel file and give an error
    On Error GoTo AdditionalDueError

    Set rAdditionalDueR = ActiveSheet.range("AdditionalDue")
    rAdditionalDueBorderR = rAdditionalDueR.Address
    rAdditionalDueR.Select

AdditionalDueResume:

    'more code in which I change format of cells based on range

    'Setting up another range that may not exists within excel file and give an error
    'Setting Up rFollowingR  as Range for Following Variable
    On Error GoTo FollowingError

    Set rFollowingR = ActiveSheet.range("Following")
    rFollowingBorderR = rFollowingR.Address
    rFollowingR.Select

FollowingResume:

    'more code in which I change format of cells based on range

    GoTo Complete
OutstandingError:
    'Error handling code here
    Resume OutstandingResume

AdditionalDueError:
    'Error handling code here
    Resume AdditionalDueResume

FollowingError:
    'Error handling code here
    Resume FollowingResume

Complete:

This solution just bypasses the block entirely without any handling code:

With range("A1:Z999")

    'Setting up another range that may not exists within excel file and give an error
    On Error GoTo OutstandingResume

    Set rOutstandingR = ActiveSheet.range("Outstanding")
    rOutstandingBorderR = rOutstandingR.Address
    rOutstandingR.Select

OutstandingResume:

    'more code in which I change format of cells based on range

    'Setting up another range that may not exists within excel file and give an error
    On Error GoTo AdditionalDueResume

    Set rAdditionalDueR = ActiveSheet.range("AdditionalDue")
    rAdditionalDueBorderR = rAdditionalDueR.Address
    rAdditionalDueR.Select

AdditionalDueResume:

    'more code in which I change format of cells based on range

    'Setting up another range that may not exists within excel file and give an error
    'Setting Up rFollowingR  as Range for Following Variable
    On Error GoTo FollowingResume

    Set rFollowingR = ActiveSheet.range("Following")
    rFollowingBorderR = rFollowingR.Address
    rFollowingR.Select

FollowingResume:

    'more code in which I change format of cells based on range

If you'd like to go in a different direction, here is a function that returns a boolean for whether or not a named range exists. Using this you could refactor this to use conditionals instead of relying on error checking and line jumps.

Private Function BET_RangeNameExists(nname) As Boolean 
Dim n As Name 
    BET_RangeNameExists = False 
    For Each n In ActiveWorkbook.Names 
        If UCase(n.Name) = UCase(nname) Then 
            BET_RangeNameExists = True 
            Exit Function 
        End If 
    Next n 
End Function

Taken from https://bettersolutions.com/excel/named-ranges/vba-named-range-exists.htm