VBA: Loop isn't working as it should

Question

Being new here I don't know if I can state my question really clear, but I'll try.

I have this VBA code which extracts certain information from an access database into an excel sheet in relation to another excel sheet. And being new to vba coding I don't know how good or correct is the method I'm using.

My problem is with the loop that's supposed to work only when 'fam' is equal to 'z' the value in a column. So, in more detail, column D from the worksheet "gbe..." contains the first 2 values of the numbers from column B, and when I give the input from my keyboard a value that is stored in 'fam' the code is supposed to search in the entire column for that value and then continue to extract from the database only the data that I'm asking for, but the loop doesn't stop when fam <> z.

I hope that you can help me, everything that I've learned about vba is from here, but now I ran out of ideas.

Sub Dateinitiale()
Dim data As Date
'Dim codprodus, codrola As Variant
Dim i, j, k, m, n, s, x, y, z2, z3 As Integer
Dim z As Variant
Dim olddb As Database, OldWs As Workspace
Set OldWs = DBEngine.Workspaces(0)
Set olddb = OldWs.OpenDatabase("C:\BusData\rfyt\xxg\_lgi\data\FyTMaes.Mdb") 'cale BD pentru importul datelor

Cells(1, 1) = "Cod Produs"
Cells(1, 2) = "Nr Rola"
Cells(1, 3) = "Masina "
Cells(1, 4) = "Data inceput"
Cells(1, 5) = "Data sfarsit"

fam = Application.InputBox("Introduceti Familia CAB", "FamCAB Search")
If fam = False Then Exit Sub
z = Worksheets("gbe03407e").Cells(2, 4).Value

x = 2
y = 2
z2 = 2

Do Until z = ""
z = Worksheets("gbe03407e").Cells(z2, 4).Value
z3 = z2
Do While fam = z

        codrola = Worksheets("gbe03407e").Cells(z3, 2).Value

        Cells(y, 2).Value = codrola
        Cells(y, 1).Value = codprodus
' write the values read from the menu into cells

        Sql = "select initra, fintra, codmaq, codsuc from tblTRAZA where numser like '" & codrola & "' and (TIPTRA='F' or TIPTRA='FA' or TIPTRA='FD' or TIPTRA='FF' or TIPTRA='FM' or TIPTRA='FT' or TIPTRA='FC' or TIPTRA='FK' or TIPTRA='FN' or TIPTRA='FQ' or TIPTRA='FR')order by fecmov"
        Set rs = olddb.OpenRecordset(Sql)
        On Error Resume Next
        rs.MoveFirst
        Do Until rs.EOF
        Cells(y, 1).Value = rs("codsuc")
        Cells(y, 3).Value = rs("codmaq")
        Cells(y, 4).Value = rs("initra")
        Cells(y, 5).Value = rs("fintra")
        rs.MoveNext
        Loop

        x = x + 1
        y = y + 8
        z3 = z3 + 1
Loop
z2 = z2 + 1
Loop
end sub

Answer 1

It seems you're not updating either z or fam inside this loop:

Do While fam = z

Which would lead to an infinite loop. If i understand correctly what you're trying to do, you should replace it with

If fam = z Then

Also, you probably want to test if your query returns any value. Something like this:

If fam = z Then
    ...
    Set rs = olddb.OpenRecordset(Sql)
    If Not rs.EoF Then
        ...
    End If
    ...
End If