MS Access VBA loop stops without error or apparent cause

Question

I'm trying to compare two arrays of data in MS Access - one is generated from an API GET, and the other is generated from two columns of a table. I'm using a double loop to do the comparison, I suspect this isn't the best way but I'm still learning my way around loops and arrays. The code I'm using is as follows:

Sub ParseList(ResCount As Long)

Dim db As DAO.Database
Dim rstConts As DAO.Recordset

Dim midstr As String, emailstr As String, Fname As String, Lname As String, SubStatus As String, echeck As String, Mecheck As String, ArrEcheck As String, ArrMecheck As String, MSub As String

Dim ArrResp() As String
Dim ArrConts() As Variant

Dim SubStart As Long, SubCount As Long, Fstart As Long, Fcount As Long, Lstart As Long, LCount As Long, Diffcount As Long, c As Long, i As Long, t As Long, y As Long, u As Long, v As Long

Dim IsSub As Boolean

Set db = CurrentDb
Udate = SQLDate(Now)

ReDim ArrResp(1 To ResCount, 1 To 4) As String

'This section parses a JSON response into an array
For i = 1 To ResCount
    midstr = ""
    emailstr = ""
    x = InStr(t + 2, GetListStr, "}}") + 21
    y = InStr(x + 1, GetListStr, "}}")
    If y = 0 Then
        Exit Sub
    End If
    midstr = Mid(GetListStr, x, y - x)
    emailstr = Left(midstr, InStr(midstr, ",") - 2)

    SubStart = InStr(midstr, "Status") + 9
    SubCount = InStr(InStr(midstr, "Status") + 8, midstr, ",") - SubStart - 1
    SubStatus = Replace(Mid(midstr, SubStart, SubCount), "'", "''")

    Fstart = InStr(midstr, ":{") + 11
    Fcount = InStr(InStr(midstr, ":{") + 11, midstr, ",") - (Fstart + 1)
    Fname = Replace(Mid(midstr, Fstart, Fcount), "'", "''")

    Lstart = InStr(midstr, "LNAME") + 8
    LCount = InStr(InStr(midstr, "LNAME") + 8, midstr, ",") - (Lstart + 1)
    Lname = Replace(Mid(midstr, Lstart, LCount), "'", "''")

    If SubStatus = "subscribed" Then
        MSub = "True"
        Else
        MSub = "False"
    End If

    ArrResp(i, 1) = emailstr
    ArrResp(i, 2) = MSub
    ArrResp(i, 3) = Fname
    ArrResp(i, 4) = Lname

    t = y
Next i

'This section grabs two columns from a database table and adds them to a second array
Set rstConts = CurrentDb.OpenRecordset("SELECT Primary_Email, EMailings FROM TBLContacts")
rstConts.MoveLast
rstConts.MoveFirst
c = rstConts.RecordCount

ReDim ArrConts(1 To c) As Variant
ArrConts = rstConts.GetRows(c)

'This loops through the JSON response array, and when it finds a matching value in the Table array it checks if a second value in the table array matches or not
For u = 1 To ResCount
    Debug.Print u
    echeck = ArrResp(u, 1)
    Mecheck = ArrResp(u, 2)
    For v = 0 To c
        If ArrConts(0, v) = "" Then
            Else
            ArrEcheck = ArrConts(0, v)
            ArrMecheck = ArrConts(1, v)
            If ArrEcheck = echeck Then
                If ArrMecheck = Mecheck Then
                    Debug.Print echeck & "Match"
                    Else
                    Debug.Print echeck & "No Match"
                End If
            End If
        End If
    Next v
Next u

MsgBox "Done"

End Sub

The code above simply doesn't complete and the msgbox is never shown. The debug.print line near the end only goes to 1, and I can't figure out why. If I remove the conditions from the second loop section:

If ArrConts(0, v) = "" Then
Else
    ArrEcheck = ArrConts(0, v)
    ArrMecheck = ArrConts(1, v)
    If ArrEcheck = echeck Then
        If ArrMecheck = Mecheck Then
            Debug.Print echeck & "Match"
            Else
            Debug.Print echeck & "No Match"
        End If
    End If
End If

Then I can successfully complete the Main loop, and receive the 'Done' message. But I've been unable to narrow down why the second loop isn't completing properly, and I'm stuck.

Is this in Access? You could use your JSON response array in a SQL statement? `Join` will join the array, so you can say `where field in (" & join(arrJson,",") & ")"` — Nathan_Sav, Feb 12 '19 at 16:31
Did you single-step (F8) through your code? If the data is huge, can you generate a small part of it and single-step through that? — , Feb 12 '19 at 16:33
This is in Access - @Nathan_Sav can you expand on this Join option? I've not encountered that before. I've tried using F8 but it isn't working, which is strange. — MrClip, Feb 12 '19 at 16:46
Yes, I have in the post, so if your array from JSON contains "Lookup1","lookup2","Lookup3", then you want to make this a SQL where condition, so you can say `select * from table where field in (" & join(arrJSON,",") & ")"` which will give you `select * from table where field in ("Lookup1","lookup2","Lookup3")` — Nathan_Sav, Feb 12 '19 at 16:48
Please wrap your entire processing with [proper error handling](https://stackoverflow.com/questions/6028288/properly-handling-errors-in-vba-excel) as a message should have raised. — Parfait, Feb 12 '19 at 17:20

Parfait · Answer 1 · 2019-02-12T17:18:55.163

Because arrays are zero-indexed, you need to subtract 1 from the upper limit of nested For loop which should have thrown an error on the subsequent If line when loop exceeded the record limit.

For u = 1 To ResCount
    Debug.Print u
    echeck = ArrResp(u, 1)
    Mecheck = ArrResp(u, 2)

    For v = 0 To c - 1                  ' REDUCE UPPER LIMIT BY 1
       If ArrConts(0, v) = "" Then      ' LINE NO LONGER SHOULD ERR OUT
       ...
    Next v
Next u

With that said, consider parsing JSON to an MS Access table using the VBA-JSON library. Then use SQL to check values with JOIN and WHERE in set-based processing between table to table. This is much more efficient that looping between arrays.

MS Access VBA loop stops without error or apparent cause

1 Answers1