'For next' loop resets counter before reaching 'ubound' resulting in infinite loop... possible name/reference clash?

Question

I am working on a multi-thousand-line program that gathers/generates a bunch of data files, all with very different formats, then collects (tabularizes) a subset of the data and conducts some analyses.

The program was working fine a few weeks ago. Now, despite not touching it since, two consecutive test runs and two step-through debugging sessions have landed in infinite for i = lbound(...) to ubound(...) .... next i loops. Relevant code reproduced, below.

The function shown simply loops through a 2D array (created by assignment of a range to a variant) for strings LIKE those in a 1D array. The range causing the error is 238x33. However, the "row" index "i" gets to 44, then resets back to 0, instead of increasing to 45 and beyond. Furthermore, when this happens, the strings being LIKEd against go from "* example*" to "** example**", the number of asterisks increasing on each side every time the "i" counter resets to 0.

My best guess is there is some kind of name/reference clash. But, why this is only arising now, and sussing it out, seems a bit beyond me.

Function definition:

Function arrayFirstLike(ByRef dataArr As Variant, ByVal fieldArr As Variant, _ 
Optional ByVal byRows As Boolean = True, Optional ByVal exactSearch As Boolean = False) As Variant

Calling lines:

Set infowb = addSaveTemplate(rootPath & templatesPath & "\yFcstIndexInfo", rootPath & countryInfoPath & "\matureMarketFcst")
Set datawb = Workbooks.Open(rootPath & countryPath & "\spdjFcst", updateLinks:=False, ReadOnly:=True)
dataArr = datawb.Worksheets("ESTIMATES&PEs").UsedRange.Value
Call closeNoAlerts(datawb)

fieldArr = Array("Data as of the close of", "S&P 500 5YR")
fieldArr2 = arrayFirstLike(dataArr, fieldArr) 'returns 2x3 zero base array of variants

Function body (please note that this is a utility function called successfully elsewhere in the program: so, before the nested loops begin, the function arguments are restructured):

Dim i As Long, j As Long, k As Long, fieldsFound As Long
Dim tempArr() As Variant

If Not IsArray(fieldArr) Then 'fieldArr is a single string
    fieldArr = Array(fieldArr)
Else
    On Error GoTo skipRedim
    i = LBound(fieldArr, 2)
    On Error GoTo 0

    ReDim tempArr(LBound(fieldArr, 1) To UBound(fieldArr, 1)) As Variant
    For i = LBound(tempArr, 1) To UBound(tempArr, 1)
        tempArr(i) = fieldArr(i, LBound(fieldArr, 2))
    Next i
    fieldArr = tempArr
afterRedim:
End If

If Not exactSearch Then
    For i = LBound(fieldArr, 1) To UBound(fieldArr, 1)
         fieldArr(i) = "*" & fieldArr(i) & "*"
    Next i
End If

ReDim tempArr(LBound(fieldArr, 1) To UBound(fieldArr, 1), 0 To 2) As Variant
fieldsFound = 0

If byRows Then
    For i = LBound(dataArr, 1) To UBound(dataArr, 1) 'rows
        For j = LBound(dataArr, 2) To UBound(dataArr, 2) 'cols
            For k = LBound(fieldArr, 1) To UBound(fieldArr, 1) 'searchlist
                If tempArr(k, 0) = Empty Then 'check for nonoccurance

                    If dataArr(i, j) Like fieldArr(k) Then 'k,1: seach string
                        tempArr(k, 0) = dataArr(i, j): tempArr(k, 1) = i: tempArr(k, 2) = j
                        fieldsFound = fieldsFound + 1
                        Exit For
                    End If

                End If
            Next k
            If fieldsFound = UBound(fieldArr, 1) - LBound(fieldArr, 1) + 1 Then Exit For
        Next j
        If fieldsFound = UBound(fieldArr, 1) - LBound(fieldArr, 1) + 1 Then Exit For
    Next i
Else
     For j = LBound(dataArr, 2) To UBound(dataArr, 2) 'cols
        For i = LBound(dataArr, 1) To UBound(dataArr, 1) 'rows
            For k = LBound(fieldArr, 1) To UBound(fieldArr, 1)
                If tempArr(k, 1) = Empty Then 'check first occurance

                    If dataArr(i, j) Like fieldArr(k) Then 'k,1: seach string
                        tempArr(k, 0) = dataArr(i, j): tempArr(k, 1) = i: tempArr(k, 2) = j
                        fieldsFound = fieldsFound + 1
                        Exit For
                    End If
                End If
            Next k
            If fieldsFound = UBound(fieldArr, 1) - LBound(fieldArr, 1) + 1 Then Exit For
        Next i
        If fieldsFound = UBound(fieldArr, 1) - LBound(fieldArr, 1) + 1 Then Exit For
    Next j
End If

arrayFirstLike = tempArr

Exit Function

skipRedim:
Resume afterRedim

score 2 · Accepted Answer · edited May 23 '17 at 11:44

2

What about this:

On Error GoTo skipRedim
i = LBound(fieldArr, 2)
On Error GoTo 0

If there's an error you skip to afterRedim: and so never execute the On Error GoTo 0. That means any later error will use the same error handler and that could easily lead to the behavior you describe. I would try to work on that first.

EDIT: you could create a function to check for the array dimensions - see examples in the answers here VBA check if array is one dimensional

edited May 23 '17 at 11:44

Community

1
1

answered Oct 23 '15 at 19:03

Tim Williams

154,628
8
97
125

The data file had, in the past few weeks, changed. The new file had an error in it, which resulted in a runtime error when the LIKE operator was called. But, because of the problem you pointed out, I could not tell. Thank you very much for your help, and for responding so quickly! – entprise Oct 23 '15 at 19:24
Regarding your edit: simply making sure that On Error GoTo 0 executes promptly after On Error GoTo skipRedim seems like the more "native VBA" solution, that's what I went with, and that's how I discovered the datafile had changed. Thank you, though. – entprise Oct 23 '15 at 20:24
Either way works - I would prefer to take the error handling out of the main sub and put it in a standalone function though. – Tim Williams Oct 23 '15 at 22:28

'For next' loop resets counter before reaching 'ubound' resulting in infinite loop... possible name/reference clash?

1 Answers1