Hi Bill,
I was hoping someone would tactfully ask you "Why?"
The query will not be updateable.
If it is for a report, it will suffer from Excel-spread.
The report design that works today will bomb
tomorrow when some group gets that one-more-than
"critical-mass" name pushing data outside your paper
borders. Excel has a printing routine where you
can make it "smaller" so it will print on your paper.
In Access, a main form (or main report) can be bound to
SELECT DISTINCT Category, NameCode
FROM yourtable;
Then a subform (or subform report) can be bound to
your table that shows Name, StartDate, EndDate
in Master/Child relationship with main form's RecordSource...
and in the subform, you can edit/delete/add Name,
StartDate, and EndDate.
Are you doing this so you can export to Excel?
Then, I agree with Mingqing Cheng that one option is to
"make a table." But it will require extaordinary code just
to make the empty table that your data will go in as names
get added to data.
For example, *IF* your field "Name" were not a reserved
word, but instead "AName"; "StartDate" was not a *string*
as it appears, but instead type DateTime; and your table
name were "tblBill":
Public Sub CreateNewTable(strNewTableName As String)
On Error GoTo Err_CreateNewTable
Dim dbs As DAO.Database
Dim tdfNew As DAO.TableDef
Dim rs As DAO.Recordset
Dim strName As String
Set dbs = CurrentDb()
'open recordset to distinct AName's
Set rs = dbs.OpenRecordset("SELECT DISTINCT AName FROM tblBill", dbOpenDynaset)
' Create a new TableDef object.
Set tdfNew = dbs.CreateTableDef(strNewTableName)
With tdfNew
.Fields.Append .CreateField("Category", dbText, 25)
.Fields.Append .CreateField("NameCode", dbLong)
.Fields.Append .CreateField("ID", dbLong)
.Fields("ID").Attributes = .Fields("ID").Attributes + dbAutoIncrField
'create "Name" fields
rs.MoveFirst
Do While Not rs.EOF
strName = rs!AName
'get rid of spaces in name
strName = Replace(strName, " ", "", 1, -1, vbTextCompare)
.Fields.Append .CreateField(strName, dbText, 25)
.Fields.Append .CreateField(strName & "StartDate", dbDate)
rs.MoveNext
Loop
rs.Close
End With
' Append the new TableDef object to the database.
dbs.TableDefs.Append tdfNew
dbs.TableDefs.Refresh
dbs.Close
MsgBox "Have successfully created empty table."
Exit_CreateNewTable:
Set tdfNew = Nothing
Set rs = Nothing
Set dbs = Nothing
Exit Sub
Err_CreateNewTable:
MsgBox Err.Description
Resume Exit_CreateNewTable
End Sub
In above case, you don't get "Name, Name2,.."
for field names, but actual name with spaces removed.
And you don't get "StartDate, StartDate2,..."
for field names, but actual name with space removed
prepended to "StartDate."
Public Sub FillNewTable(strNewTableName As String)
On Error GoTo Err_FillNewTable
Dim dbs As DAO.Database
Dim rs As DAO.Recordset
Dim strName As String
Dim strCategory As String
Dim lngNameCode As Long
Dim varStartDate As Variant
Dim strSQL As String
Set dbs = CurrentDb()
'insert distinct Category/NameCode into new table
strSQL = "INSERT INTO " & strNewTableName & "(Category, NameCode) " _
& "SELECT DISTINCT Category, NameCode FROM tblBill;"
dbs.Execute strSQL, dbFailOnError
'open recordset to original table
Set rs = dbs.OpenRecordset("SELECT * FROM tblBill", dbOpenDynaset)
rs.MoveFirst
Do While Not rs.EOF
strName = rs!AName
'get rid of spaces in name
strName = Replace(strName, " ", "", 1, -1, vbTextCompare)
strCategory = rs!Category
lngNameCode = rs!NameCode
varStartDate = rs!StartDate
'insert values
strSQL = "UPDATE " & strNewTableName & " SET " & strName & " = '" _
& strName & "', " & strName & "StartDate = " _
& Format(varStartDate, "\#mm\/dd\/yyyy\#") _
& " WHERE Category = '" & strCategory & "' AND " _
& "NameCode = " & lngNameCode
'Debug.Print strSQL
dbs.Execute strSQL, dbFailOnError
rs.MoveNext
Loop
rs.Close
dbs.Close
MsgBox "Have successfully filled new table."
Exit_FillNewTable:
Set rs = Nothing
Set dbs = Nothing
Exit Sub
Err_FillNewTable:
MsgBox Err.Description
Resume Exit_FillNewTable
End Sub
So...this is an example of how you might
proceed, but you have to wonder if it is
truly necessary, don't you?
Good luck,
Gary Walter
