In absence of schema DDL and sample data (which is netiquette in the
RDBMS ngs <g>), I'll say you want a LEFT JOIN with the Phones table on
the right. You can test for users with no row in the Phones table by
testing for null in the Phone field of the results set.
This would get you the *data* you require. However, it would not be in
the 'many-to-one' format you asked for. I'm sure it is *possible* to
do with SQL. One approach that springs to mind is to create a temp
table by UNIONing two queries, each sorting on the Phone column and
selecting the first then the second row using a COUNT, then self
joining the temp table to disregard the columns with nulls.
However, while possible I wouldn't recommend a SQL solution. It's
easier to do in the front end i.e. looping through a recordset ordered
on the Phone field, keep a row count for the current ID and convert
(non null) rows to a columns. Hard to write some sample code though
without knowing any info about your worksheet.
....so I'll start from scratch, build a new database with tables
stripped down to the basics and invent some sample data. Try this in a
new blank workbook:
Option Explicit
Sub Test()
Dim Cat As Object
Dim Con As Object
Dim rs As Object
Dim strConJet As String
Dim strSql1 As String
Dim strSql2 As String
Dim strSql3 As String
Dim rsFab As Object
Dim lngCurrentID As Long
Dim lngCounter As Long
Dim oTarget As Excel.Range
' Amend the following constants to suit
Const PATH As String = "" & _
"C:\Temp\"
Const FILENAME_JET As String = "" & _
"New_Jet_DB.mdb"
' Don't amend this one though
Const CONN_STRING_JET As String = "" & _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=<PATH><FILENAME>"
' Build connection string
strConJet = CONN_STRING_JET
strConJet = Replace(strConJet, "<PATH>", PATH)
strConJet = Replace(strConJet, "<FILENAME>", FILENAME_JET)
' Build sql statements
strSql1 = ""
strSql1 = strSql1 & "CREATE TABLE CommsUsers ("
strSql1 = strSql1 & " ID INTEGER NOT NULL PRIMARY KEY,"
strSql1 = strSql1 & " lname VARCHAR(35) NOT NULL,"
strSql1 = strSql1 & " fname VARCHAR(35) NOT NULL,"
strSql1 = strSql1 & " mname VARCHAR(35) NOT NULL"
strSql1 = strSql1 & " DEFAULT '{{NA}}'"
strSql1 = strSql1 & ");"
strSql2 = ""
strSql2 = strSql2 & "CREATE TABLE Phones ("
strSql2 = strSql2 & " ID INTEGER NOT NULL"
strSql2 = strSql2 & " REFERENCES CommsUsers (ID),"
strSql2 = strSql2 & " Phone VARCHAR(15) NOT NULL"
strSql2 = strSql2 & ");"
strSql3 = ""
strSql3 = strSql3 & "SELECT cm.ID, cm.lname,"
strSql3 = strSql3 & " cm.fname, ph.Phone"
strSql3 = strSql3 & " FROM CommsUsers cm"
strSql3 = strSql3 & " LEFT JOIN Phones ph"
strSql3 = strSql3 & " ON cm.ID=ph.ID;"
' Create new Jet database
Set Cat = CreateObject("ADOX.Catalog")
Cat.CREATE strConJet
' 'inherit' the connection
Set Con = Cat.ActiveConnection
Set Cat = Nothing
With Con
' Create tables
.Execute strSql1
.Execute strSql2
' Create some sample data
.Execute "INSERT INTO CommsUsers (ID, lname, fname)" & _
" VALUES (1, 'Livehulas', 'A')"
.Execute "INSERT INTO CommsUsers (ID, lname, fname)" & _
" VALUES (2, 'Katewudes', 'B')"
.Execute "INSERT INTO CommsUsers (ID, lname, fname)" & _
" VALUES (3, 'Hevitoxic', 'C')"
.Execute "INSERT INTO CommsUsers (ID, lname, fname)" & _
" VALUES (4, 'Norarules', 'D')"
.Execute "INSERT INTO Phones (ID, Phone)" & _
" VALUES (1, '123')"
.Execute "INSERT INTO Phones (ID, Phone)" & _
" VALUES (1, '456')"
.Execute "INSERT INTO Phones (ID, Phone)" & _
" VALUES (2, '555')"
.Execute "INSERT INTO Phones (ID, Phone)" & _
" VALUES (2, '444')"
.Execute "INSERT INTO Phones (ID, Phone)" & _
" VALUES (4, '789')"
End With
' Fabricate a recordset
Set rsFab = CreateObject("ADODB.Recordset")
With rsFab
.CursorType = 2 ' adOpenDynamic
.CursorLocation = 3 ' adUseClient
.LockType = 4 ' adLockBatchOptimistic
With .fields
.Append "ID", 3 ' Integer
.Append "lname", 200, 35 ' VarChar(35)
.Append "fname", 200, 35
.Append "Phone1", 200, 15 ' VarChar(15)
.Append "Phone2", 200, 15
End With
.Open
End With
' Open the real recordset
Set rs = Con.Execute(strSql3)
With rs
' Populate fabricated recordset
Do While Not .EOF
rsFab.AddNew _
Array("ID", "lname", "fname"), _
Array(!ID, !lname, !fname)
If IsNull(!Phone) Then
.MoveNext
Else
rsFab!Phone1 = !Phone
lngCurrentID = !ID
.MoveNext
If Not .EOF Then
If lngCurrentID = !ID Then
rsFab!Phone2 = !Phone
.MoveNext
End If
End If
End If
Loop
' Clean up
.Close
End With
Con.Close
' Copy data to ThisWorkbook
With rsFab
.UpdateBatch
.MoveFirst
Set oTarget = ThisWorkbook.Worksheets(1) _
.Range("A1")
For lngCounter = 1 To .fields.Count
oTarget(1, lngCounter).Value = _
.fields(lngCounter - 1).Name
Next
End With
oTarget(2, 1).CopyFromRecordset rsFab
End Sub
--
