List boxes match

[abenitez77]

Is there a way to have 2 list boxes that are side by side and 1 contains a list of the fields from table A and the other a list of the fields from table B and then you match the fields by dragging and dropping one field onto the other. I am wanting to match the fields so that I can use them later to alias the fields with the field names in the other table.

 

[MajP]

Yes you could make this. Dragging and dropping is probably not the easiest thing to do in Access. I think if I was doing this I would have three listboxes.

lstA: unmatched values from table A
lstB: unmatched values from table B
lstMatched: A two column listbox showing the matches.

Select a value from A, Select a value from B then have a button to add the matches to lstMathched. Also have a button to remove a match.

This would be a lot easier to code then the drag and drop.

 

[abenitez77]

This does sound easier to accomplish. Thanks! I'm sure I will be posting my progress as I have not worked with listboxes much.

 

[MajP]

Here is a quick demo

http://www.4shared.com/document/zX50hel8/MatchList_v20.html

Basically it saves the field names to a table "tblMatches"

You can build a listbox from a field list, but AfAIK there is no way to filter that list once you build it. You want to be able to remove items from lstA and lstB after you create a match. So I did not use the field list property and instead fill the lists with all the fields by looping the tables fields collection. Then I remove any items that exist in the match list.

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

However you can simplify this a lot by first writing all the tables and field names to a table
tblTablesAndFields

Then you can populates the different lists using pure sql.
The code then becomes

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
    Me.lstA.Requery
    Me.lstB.Requery
  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
    Me.lstA.Requery
    Me.lstB.Requery
  Else
    MsgBox "No values selected."
  End If
End Sub
Public Sub loadTablesAndFields()
  Dim rs As DAO.Recordset
  Dim fldname As String
  Dim fld As DAO.Field
  Dim strSql As String
  Dim strValues As String
  
  strSql = "DELETE * from tblTablesAndFields"
  CurrentDb.Execute strSql
  Set rs = CurrentDb.OpenRecordset("tblA")
  For Each fld In rs.Fields
    strSql = "INSERT INTO tblTablesAndFields (tblName,fldName) VALUES "
    strValues = "('tblA','" & fld.Name & "')"
    strSql = strSql & strValues
    CurrentDb.Execute strSql
  Next fld
  Set rs = CurrentDb.OpenRecordset("tblB")
  For Each fld In rs.Fields
    strSql = "INSERT INTO tblTablesAndFields (tblName,fldName) VALUES "
    strValues = "('tblB','" & fld.Name & "')"
    strSql = strSql & strValues
    CurrentDb.Execute strSql
  Next fld
  lstA.Requery
  lstB.Requery
End Sub

look at the rowsource for the lists to see how this works.

 

[abenitez77]

This is great, Thanks!