How to avoid or check in advance Runtime Error 5 using MID?

[ChrisGudrich]

Dear Board Members,

First of all, I would like to praise the fantastic solutions that I have been able to implement with your help so far ... and so far without having to ask.

This time, unfortunately, neither the search nor presumed solutions from other problems solved my problem.

The following general conditions:
This "macro" searches XML files for certain invalid formats. This all works perfectly, at least until mid returns the value 0 / Zero and then aborts with runtime error 5.

Here is the complete code:

Sub Analyse_Format_Bold()
    Dim strLine As String
    Dim f As Integer
    Dim lngLine As Long
    Dim blnFound As Boolean
    Dim strFileName
    Dim WhichRowAmI As Integer
    Dim strQuote
    Dim SplitCatcher As Variant
    Dim Counter As Integer
    Dim i As Integer
    Dim openPos As Integer
    Dim closePos As Integer
    Dim str1 As String
   
    f = FreeFile
    ' Select cell A2, *first line of data*.
    Range("B2").Select
    ' Set Do loop to stop when an empty cell is reached.
        Do Until IsEmpty(ActiveCell)
            strFileName = Worksheets("Data").Range("B" & ActiveCell.Row)
            strQuote = Chr$(34)
            Const strSearch = "<emphasis role=" & """" & "default" & """" & ">"
            Const strSearch2 = "<entry><emphasis role=" & """" & "default" & """" & ">"
            Const strSearch3 = "<entry><para><emphasis role=" & """" & "default" & """" & ">"
            Const strSearch4 = "<title><emphasis role=" & """" & "default" & """" & ">"
            Const strSearch5 = "<emphasis role=" & """" & "default" & """" & ">***"
            Open strFileName For Input As #f
            'Schleife 1
            Do While Not EOF(f)
                lngLine = lngLine + 1
                Line Input #f, strLine
                If InStr(1, strLine, strSearch, vbBinaryCompare) > 0 Then
                    If InStr(1, strLine, strSearch2, vbBinaryCompare) > 0 Then
                        Range("L" & ActiveCell.Row).Value = "NoMatch"
                        ' Step down 1 row from present location.
                        Range("B" & ActiveCell.Row).Select
                        ActiveCell.Offset(1, 0).Select
                        Close #f
                        Exit Do
                    ElseIf InStr(1, strLine, strSearch3, vbBinaryCompare) > 0 Then
                        Range("L" & ActiveCell.Row).Value = "NoMatch"
                        ' Step down 1 row from present location.
                        Range("B" & ActiveCell.Row).Select
                        ActiveCell.Offset(1, 0).Select
                        Close #f
                        Exit Do
                    ElseIf InStr(1, strLine, strSearch4, vbBinaryCompare) > 0 Then
                        Range("L" & ActiveCell.Row).Value = "NoMatch"
                        ' Step down 1 row from present location.
                        Range("B" & ActiveCell.Row).Select
                        ActiveCell.Offset(1, 0).Select
                        Close #f
                        Exit Do
                    ElseIf InStr(1, strLine, strSearch5, vbBinaryCompare) > 0 Then
                        Range("L" & ActiveCell.Row).Value = "NoMatch"
                        ' Step down 1 row from present location.
                        Range("B" & ActiveCell.Row).Select
                        ActiveCell.Offset(1, 0).Select
                        Close #f
                        Exit Do
                    Else
                        Range("L" & ActiveCell.Row).Value = "Match"
                        SplitCatcher = Split(strLine, "<emphasis role=" & """" & "default" & """" & ">")
                       
                        For Counter = 0 To UBound(SplitCatcher)
             
                            If i >= 1 Then
                                strLine = SplitCatcher(Counter)
                            End If
                           
                            openPos = InStr(strLine, "<emphasis role=" & """" & "default" & """" & ">")
                            closePos = InStr(strLine, "</emphasis>")
                       
                            str1 = Mid(strLine, openPos + 1, closePos - openPos - 1)
                            str1 = Replace(str1, "<emphasis role=" & """" & "default" & """" & ">", "")
                            If InStr(1, str1, "<emphasis role=" & """" & "italic" & """" & ">") >= 0 Then
                                str1 = Replace(str1, "<emphasis role=" & """" & "italic" & """" & ">", "")
                            End If
                            Range("AJ" & ActiveCell.Row).Value = Range("AJ" & ActiveCell.Row).Value & str1 & ", "
                            i = i + 1
                        Next
                     
                        blnFound = True
                        If Not Range("AJ" & ActiveCell.Row).Value = "" Then
                            Range("AJ" & ActiveCell.Row).Value = Left(Range("AJ" & ActiveCell.Row).Value, Len(Range("AJ" & ActiveCell.Row).Value) - 3)
                        End If
                        ' Step down 1 row from present location.
                        Range("B" & ActiveCell.Row).Select
                        ActiveCell.Offset(1, 0).Select
                        Close #f
                        Exit Do
                    End If
                ElseIf Sheets("Data").Range("H" & ActiveCell.Row).Value = "N/A" Then
                    Range("L" & ActiveCell.Row).Value = "N/A"
                    ' Step down 1 row from present location.
                    Range("B" & ActiveCell.Row).Select
                    ActiveCell.Offset(1, 0).Select
                    Close #f
                    Exit Do
                Else
                    Range("L" & ActiveCell.Row).Value = "NoMatch"
                    ' Step down 1 row from present location.
                    Range("B" & ActiveCell.Row).Select
                    ActiveCell.Offset(1, 0).Select
                    Close #f
                    Exit Do
                End If
            Loop
        Loop
End Sub

The following code line is ejected as faulty:

str1 = Mid(strLine, openPos + 1, closePos - openPos - 1)

As a solution, I would like to think of a preliminary check that first checks whether 0 / Zero is returned and then continues to run in the loop.

Thank you very much!
Chris

 

[rlv01]

In order to continue to run the loop, str1 must have a value. What value do you want to assign to str1 in the event of a runtime error 5 to allow it to continue to run in the loop?

    str1 = "XXX" '<- error value for str1 that you choose.
    On Error Resume Next
    str1 = Mid(strLine, openpos + 1, closepos - openpos - 1)
    On Error GoTo 0

 

[ChrisGudrich]

In order to continue to run the loop, str1 must have a value. What value do you want to assign to str1 in the event of a runtime error 5 to allow it to continue to run in the loop?

    str1 = "XXX" '<- error value for str1 that you choose.
    On Error Resume Next
    str1 = Mid(strLine, openpos + 1, closepos - openpos - 1)
    On Error GoTo 0

I already had the idea, but then an empty entry would be created in the Excel list, which I would have to clean up later.

In terms of workflow, I would prefer the following solution (but the developer in me is lost ):

Check if:

Mid(strLine, openPos + 1, closePos - openPos - 1)

returns nothing, please do nothing and loop. Otherwise add the value to the Excel cell.

 

[rlv01]

Then perhaps something like this:

                    For Counter = 0 To UBound(SplitCatcher)

                        If i >= 1 Then
                            strLine = SplitCatcher(Counter)
                        End If

                        openPos = InStr(strLine, "<emphasis role=" & """" & "default" & """" & ">")
                        closePos = InStr(strLine, "</emphasis>")

                        str1 = "Error!"               '<- error value for str1 that you choose.
                        On Error Resume Next
                        str1 = Mid(strLine, openPos + 1, closePos - openPos - 1)
                        On Error GoTo 0

                        If str1 <> "Error!" Then
                            str1 = Replace(str1, "<emphasis role=" & """" & "default" & """" & ">", "")
                            If InStr(1, str1, "<emphasis role=" & """" & "italic" & """" & ">") >= 0 Then
                                str1 = Replace(str1, "<emphasis role=" & """" & "italic" & """" & ">", "")
                            End If
                            Range("AJ" & ActiveCell.Row).Value = Range("AJ" & ActiveCell.Row).Value & str1 & ", "
                        End If
                        i = i + 1
                    Next Counter                      '<- best practice is to always include name of looping variable

 

[ChrisGudrich]

Then perhaps something like this:

                    For Counter = 0 To UBound(SplitCatcher)

                        If i >= 1 Then
                            strLine = SplitCatcher(Counter)
                        End If

                        openPos = InStr(strLine, "<emphasis role=" & """" & "default" & """" & ">")
                        closePos = InStr(strLine, "</emphasis>")

                        str1 = "Error!"               '<- error value for str1 that you choose.
                        On Error Resume Next
                        str1 = Mid(strLine, openPos + 1, closePos - openPos - 1)
                        On Error GoTo 0

                        If str1 <> "Error!" Then
                            str1 = Replace(str1, "<emphasis role=" & """" & "default" & """" & ">", "")
                            If InStr(1, str1, "<emphasis role=" & """" & "italic" & """" & ">") >= 0 Then
                                str1 = Replace(str1, "<emphasis role=" & """" & "italic" & """" & ">", "")
                            End If
                            Range("AJ" & ActiveCell.Row).Value = Range("AJ" & ActiveCell.Row).Value & str1 & ", "
                        End If
                        i = i + 1
                    Next Counter                      '<- best practice is to always include name of looping variable

Thank you for the solution. That looks very good.