HELP - VBA loop code dosen't work

Lennon

New member
Local time
Today, 17:33
Joined
Feb 24, 2012
Messages
8
Hy to all!

I having problem with looping through records.
I have a search form with two subforms:
1. list of all members,
2. list of all dates when they come to a meeting.
I have a text box where I enter a date and then it filter the records in 2. subform and show me all the ID's of members that were on meeting that day. But it won't filter the records in first subform so that i can see the names of members!

This is what it looks like:
1.

ID l name l lastname l address l phone l city
1 l joe l witt l av 3 l 55655 l ny
2 l mary l asdasd l asdasd l 45435 l mi
3 l ivan l asdaas l sadsd l asdas l lv
4 l will l asdasd l asdasd l sdasd l ny
.
.
.


2.
ID l date
1 l 01.01.2012.
2 l 12.02.2012.
3 l 01.01.2012.
.
.

If I want to show me only those that were on 01.01.2012. then it looks like this:

1.
ID l name l lastname l address l phone l city
1 l joe l witt l av 3 l 55655 l ny

2.
ID l date
1 l 01.01.2012.
3 l 01.01.2012.

So, it showing me only the first record, and not the rest of it in first subform.

My code is like this:

Code:
Option Compare Database
Option Explicit

Private Sub btnClear_Click()
    Dim intIndex As Integer
    Dim intIndex2 As Integer
    Dim intIndex3 As Integer
                  
    
    ' Deselktiranje odabarnih iz liste
    For intIndex = 0 To Me.lstSpol.ListCount - 1
        Me.lstSpol.Selected(intIndex) = False
    Next
    
    For intIndex2 = 0 To Me.lstKGr.ListCount - 1
        Me.lstKGr.Selected(intIndex2) = False
    Next
    
    For intIndex3 = 0 To Me.lstRh.ListCount - 1
        Me.lstRh.Selected(intIndex3) = False
    Next
    
    Me.txtMaxAge = ""
    Me.txtMinAge = ""
    Me.txtBrDavMax = ""
    Me.txtBrDavMin = ""
    Me.txtDatumDavanja = ""
    Me.txtBrKorisnika = ""
        
    
    ' Update
    Me.Odabir_subform.Form.RecordSource = "SELECT * FROM Odabir"
    Me.qryDatum_Davanja_subform.Form.RecordSource = "SELECT * FROM qryDatum_Davanja"
        
    ' Requery subform
    Me.Odabir_subform.Requery
    Me.qryDatum_Davanja_subform.Requery
        
End Sub

Private Sub btnSearch_Click()
Const conJetDate = "\#mm\/dd\/yyyy\#"

  
   ' Update the record source
    If Me.txtDatumDavanja = "" Then
        Me.Odabir_subform.Form.RecordSource = "SELECT * FROM Odabir WHERE " & BuildFilter
    ElseIf Me.txtDatumDavanja <> "" Then
        Me.qryDatum_Davanja_subform.Form.RecordSource = "SELECT * FROM qryDatum_Davanja WHERE [Datum davanja] = " & Format(Me.txtDatumDavanja, conJetDate)
 
    
    Dim db As dao.Database
    Dim rs As dao.Recordset
    Dim sqlStr As String

    sqlStr = "SELECT * FROM qryDatum_Davanja WHERE [Datum davanja] = " & Format(Me.txtDatumDavanja, conJetDate)

    Set db = CurrentDb
    Set rs = db.OpenRecordset(sqlStr, dbOpenDynaset)

    rs.MoveFirst

    Do While Not rs.EOF Or rs.BOF
         Me.Odabir_subform.Form.RecordSource = "SELECT * FROM Odabir WHERE ID = " & rs!ID
    rs.MoveNext
    Loop

    
    End If
        
   ' Requery subform
    Me.qryDatum_Davanja_subform.Requery
    Me.Odabir_subform.Requery
   
   ' Prebroji korisnike
    Me.txtBrKorisnika = Me.Controls("Odabir_subform").Form.Recordset.RecordCount
 
  
End Sub


Private Sub Form_Load()
    
    ' Clear the search form
    btnClear_Click
    
End Sub

Private Function BuildFilter() As Variant
    Dim BuildFilter2 As Variant
    Dim BuildFilter3 As Variant
    Dim BuildFilter4 As Variant
            
    Dim varWhere As Variant
    Dim varWhere2 As Variant
    Dim varWhere3 As Variant
    Dim varWhere4 As Variant
                
    Dim varSpol As Variant
    Dim varItem As Variant
    Dim intIndex As Integer
    
    Dim varKgr As Variant
    Dim varItem2 As Variant
    Dim intIndex2 As Integer
    
    Dim varRh As Variant
    Dim varItem3 As Variant
    Dim intIndex3 As Integer
        

    'Filteri na nulu
    varWhere = Null
    varSpol = Null
    varKgr = Null
    varWhere2 = Null
    varRh = Null
    varWhere3 = Null
    varWhere4 = Null
    
    
    ' Godina
    If Me.txtMinAge > "" Then
        varWhere = varWhere & "[Starost] >= " & Me.txtMinAge & " AND "
    End If
    
    If Me.txtMaxAge > "" Then
        varWhere = varWhere & "[Starost] <= " & Me.txtMaxAge & " AND "
    End If
   
   
    ' Broj davanja
    If Me.txtBrDavMin > "" Then
        varWhere = varWhere & "[Broj davanja] >= " & Me.txtBrDavMin & " AND "
    End If
    
    If Me.txtBrDavMax > "" Then
        varWhere = varWhere & "[Broj davanja] <= " & Me.txtBrDavMax & " AND "
    End If
    
    
    ' Lista Spol
    For Each varItem In Me.lstSpol.ItemsSelected
        varSpol = varSpol & "[Spol] = """ & _
                    Me.lstSpol.ItemData(varItem) & """ OR "
        
    Next
    
    ' Lista Krvna grupa
    For Each varItem2 In Me.lstKGr.ItemsSelected
        varKgr = varKgr & "[Krvna grupa] = """ & _
                    Me.lstKGr.ItemData(varItem2) & """ OR "
    Next
    
    ' Lista Rh faktor
    For Each varItem3 In Me.lstRh.ItemsSelected
        varRh = varRh & "[Rh faktor] = """ & _
                    Me.lstRh.ItemData(varItem3) & """ OR "
    Next
    
    
    ' Provjere lista
    If IsNull(varSpol) Then
        'Ne radi ništa
    Else
        ' Micanje "OR" u filteru
        If Right(varSpol, 4) = " OR " Then
            varSpol = Left(varSpol, Len(varSpol) - 4)
        End If
        varWhere = varWhere & "( " & varSpol & " )"
    End If
    
    If IsNull(varKgr) Then
      'Ne radi ništa
    Else
        ' Micanje "OR" u filteru
        If Right(varKgr, 4) = " OR " Then
            varKgr = Left(varKgr, Len(varKgr) - 4)
        End If
        varWhere2 = varWhere2 & "( " & varKgr & " )"
    End If
        
    If IsNull(varRh) Then
        'Ne radi ništa
    Else
        ' Micanje "OR" u filteru
        If Right(varRh, 4) = " OR " Then
            varRh = Left(varRh, Len(varRh) - 4)
        End If
        varWhere3 = varWhere3 & "( " & varRh & " )"
    End If
        
           
    ' Provjera filtera
    If IsNull(varWhere) Then
        varWhere = ""
    Else
        varWhere = varWhere
       ' Micanje "AND"
        If Right(varWhere, 5) = " AND " Then
            varWhere = Left(varWhere, Len(varWhere) - 5)
        End If
    End If
    
    If IsNull(varWhere2) Then
        varWhere2 = ""
    Else
        varWhere2 = varWhere2
       ' Micanje "AND"
        If Right(varWhere2, 5) = " AND " Then
            varWhere2 = Left(varWhere2, Len(varWhere2) - 5)
        End If
    End If
    
    If IsNull(varWhere3) Then
        varWhere3 = ""
    Else
        varWhere3 = varWhere3
       ' Micanje "AND"
        If Right(varWhere3, 5) = " AND " Then
            varWhere3 = Left(varWhere3, Len(varWhere3) - 5)
        End If
    End If
    
    
    'Stvaranje filtera
    BuildFilter2 = varWhere & " AND " & varWhere2
    
    If IsNull(BuildFilter2) Then
        BuildFilter2 = ""
    Else
        BuildFilter2 = BuildFilter2
       ' Micanje "AND"
        If Right(BuildFilter2, 5) = " AND " Then
            BuildFilter2 = Left(BuildFilter2, Len(BuildFilter2) - 5)
        End If
        If Left(BuildFilter2, 5) = " AND " Then
            BuildFilter2 = Right(BuildFilter2, Len(BuildFilter2) - 5)
        End If
    End If
    
    
    BuildFilter3 = BuildFilter2 & " AND " & varWhere3
    
    If IsNull(BuildFilter3) Then
        BuildFilter3 = ""
    Else
        BuildFilter3 = BuildFilter3
       ' Micanje "AND"
        If Right(BuildFilter3, 5) = " AND " Then
            BuildFilter3 = Left(BuildFilter3, Len(BuildFilter3) - 5)
        End If
        If Left(BuildFilter3, 5) = " AND " Then
            BuildFilter3 = Right(BuildFilter3, Len(BuildFilter3) - 5)
        End If
    End If
        
    ' Glavni filter
    BuildFilter = BuildFilter3
      
End Function
 
But it won't filter the records in first subform so that i can see the names of members!

Quickly glancing through your code, the search event does not seem to be updating both subform controls.

Each form is its own data model, so in order to get the data to update, you need to send each form/subform events to update the search criteria / requery / refresh. There is no osmosis magic that assumes that since you upgrade one form's query the other forms / subforms are kept in sync.
 
But I connect them with code


Me.Odabir_subform.Form.RecordSource = "SELECT * FROM Odabir WHERE ID = " & Me.qryDatum_Davanja_subform.Form!ID

Odabir subform is one, qryDatum_Davanja_subform is another subform. And it dosen't work. I'm not good at vba, but I think that should work. It tells that on first subform show data that answer criteria of other.
 
But I connect them with code

Me.Odabir_subform.Form.RecordSource = "SELECT * FROM Odabir WHERE ID = " & Me.qryDatum_Davanja_subform.Form!ID

That bit of code merely harvests a value from one subform control and uses it as part of the SQL that is fed into another subform.

Doing so does not link the two subforms, nor tell them both to requery / refresh.
 

Users who are viewing this thread

Back
Top Bottom