Private Sub cmdMatch_Click()
Dim strsql As String
If Not IsNull(lstA) And Not IsNull(lstB) Then
strsql = "INSERT INTO tblMatches (fldA,fldB) values ('" & Me.lstA & "','" & Me.lstB & "')"
CurrentDb.Execute strsql
Me.lstMatch.Requery
DoEvents
loadLists
Else
MsgBox "Select two values to match"
End If
End Sub
Private Sub cmdUnMatch_Click()
Dim strsql As String
Dim strWhere As String
If Not IsNull(lstMatch) Then
strWhere = "fldA = '" & lstMatch.Column(0) & "' AND fldB = '" & lstMatch.Column(1) & "'"
strsql = "Delete * from tblMatches where " & strWhere
CurrentDb.Execute strsql
lstMatch.Requery
loadLists
Else
MsgBox "No values selected."
End If
End Sub
Private Sub Form_Load()
loadLists
End Sub
Public Sub fillA()
Dim rs As DAO.Recordset
Dim fld As DAO.Field
Dim lst As Access.ListBox
Set lst = Me.lstA
lst.RowSourceType = "value list"
lst.RowSource = ""
Set rs = CurrentDb.OpenRecordset("tblA")
For Each fld In rs.Fields
lst.AddItem fld.Name
Next fld
End Sub
Public Sub fillB()
Dim rs As DAO.Recordset
Dim fld As DAO.Field
Dim lst As Access.ListBox
Set lst = Me.lstB
lst.RowSourceType = "value list"
lst.RowSource = ""
Set rs = CurrentDb.OpenRecordset("tblB")
For Each fld In rs.Fields
lst.AddItem fld.Name
Next fld
End Sub
Public Sub delItemInA()
Dim lstItm As String
Dim i As Integer
Dim varIndex As Variant
For i = 0 To lstMatch.ListCount - 1
varIndex = getIndex(lstA, lstMatch.Column(0, i))
If Not IsNull(varIndex) Then
lstA.RemoveItem (varIndex)
End If
Next i
End Sub
Public Sub delItemInB()
Dim lstItm As String
Dim i As Integer
Dim varIndex As Variant
For i = 0 To lstMatch.ListCount - 1
varIndex = getIndex(lstB, lstMatch.Column(1, i))
If Not IsNull(varIndex) Then
lstB.RemoveItem (varIndex)
End If
Next i
End Sub
Public Function getIndex(lst As Access.ListBox, strText As String) As Variant
Dim itm As String
Dim i As Integer
For i = 1 To lst.ListCount - 1
If lst.Column(0, i) = strText Then
getIndex = i
End If
Next i
End Function
Public Sub loadLists()
fillA
fillB
delItemInA
delItemInB
End Sub