VBA: Loop isn't working as it should - sql

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