Bill Sturdevant said:
I have a table with 100 fields. I do NOT have any option to modify the table.
Each of the fields has a numeric value.
I need a query that will result in a list of records, each one containing
the name of one of the fields in column 1 and the value of that field in
column 2, for all fields where the value in the field is > 0.
Query Results:
Column 1 Column 2
name of FieldA value of FieldA
name of FieldB value of FieldB
name of FieldD value of FieldD
Hi Bill,
In addition to John's sage advice,
I might think about saving the data
to a thin table (even if the Union query
does not choke on "too complex", I imagine
using the query for any further processing
will affect performance).
So...one alternative might be to save the
following code in a new module:
'****** start of code **************
Option Explicit
Public Sub fImportToThinTable(pFromTable As Variant, pToTable As Variant)
On Error GoTo Err_fImportToThinTable
Dim rsFrom As DAO.Recordset
Dim rsTo As DAO.Recordset
Dim Response, strMsg As String, varReturn
Dim strSQL As String
Dim lngVal As Long
Dim lngRecNum As Long, i As Long
'check that pFromTable is not null nor ZLS
If Len(Trim(pFromTable & "")) > 0 Then
'check that pToTable is not null nor ZLS
If Len(Trim(pToTable & "")) > 0 Then
'continue processing
Else
MsgBox "Please provide name of wide table " _
& "with many number fields."
GoTo Exit_fImportToThinTable
End If
Else
MsgBox "Please provide name of thin table " _
& "you wish to fill with number data."
GoTo Exit_fImportToThinTable
End If
strMsg = "Will be importing number data from the following table:" _
& vbCrLf & vbCrLf & pFromTable & vbCrLf & vbCrLf _
& "into the following thin table:" _
& vbCrLf & vbCrLf & pToTable
Response = MsgBox(strMsg, vbOKCancel)
If Response = vbCancel Then ' User chose to Cancel
GoTo Exit_fImportToThinTable
End If
DoCmd.Hourglass True
'check if pToTable exists
If TableExists(CStr(pToTable)) Then
'if it exists, clear out all data
CurrentDb.Execute "DELETE * FROM " & pToTable, dbFailOnError
Else
'does not exist, so create it
strSQL = "CREATE TABLE " & pToTable & " (ID AUTOINCREMENT, " _
& "FldName TEXT, FldValue LONG, " _
& "CONSTRAINT PK_ID PRIMARY KEY (ID ));"
'Debug.Print strSQL
CurrentDb.Execute strSQL, dbFailOnError
End If
Set rsFrom = CurrentDb.OpenRecordset(pFromTable, dbOpenDynaset)
'quit if empty table
If rsFrom.EOF = True Then
rsFrom.Close
MsgBox pFromTable & " does not contain any records.", vbCritical
GoTo Exit_fImportToThinTable
Else
'continue
End If
Set rsTo = CurrentDb.OpenRecordset(pToTable, dbOpenDynaset)
rsFrom.MoveFirst
lngRecNum = 0
Do While Not rsFrom.EOF
lngRecNum = lngRecNum + 1
'****** update progress display in status bar *****************
varReturn = SysCmd(acSysCmdSetStatus, "Processing Rec # " & lngRecNum)
For i = 0 To rsFrom.Fields.Count - 1
'**** save only nonNull, positive values ****
'test rsFrom value
If rsFrom.Fields(i) > 0 Then
With rsTo
.AddNew
!FldName = rsFrom.Fields(i).Name
!FldValue = rsFrom.Fields(i)
.Update
End With
Else
'don't save null or negative values
End If
Next i
rsFrom.MoveNext
Loop
'clear display in status bar
varReturn = SysCmd(acSysCmdClearStatus)
rsFrom.Close
rsTo.Close
MsgBox "Have successfully imported number data from " & vbCrLf _
& pFromTable & vbCrLf & " into table " & pToTable & "."
Exit_fImportToThinTable:
DoCmd.Hourglass False
Set rsFrom = Nothing
Set rsTo = Nothing
Exit Sub
Err_fImportToThinTable:
MsgBox Err.Description
Resume Exit_fImportToThinTable
End Sub
Public Function TableExists(strTableName As String) As Boolean
'from Joe Fallon
On Error Resume Next
TableExists = IsObject(CurrentDb.TableDefs(strTableName))
End Function
'******** end of code *************
Save the module (giving it a new like "modImport").
Click on "Debug/Compile.." in top menu to make
sure didn't get some word-wrap problem in the
copy and paste.
To test this, I made the following simple table "tblManyFields"
f1 f2 f3 f4 f5
1 2 3 4 5
6 7 8 9 10
11 12 13 14 15
16 17 18 19 20
In the Immediate Window, I then entered the following
and hit ENTER
fImportToThinTable "tblManyFields","tblThin"
and "tblThin" ended up with following values:
ID FldName FldValue
1 f1 1
2 f2 2
3 f3 3
4 f4 4
5 f5 5
6 f1 6
7 f2 7
8 f3 8
9 f4 9
10 f5 10
11 f1 11
12 f2 12
13 f3 13
14 f4 14
15 f5 15
16 f1 16
17 f2 17
18 f3 18
19 f4 19
20 f5 20
I think this is what you wanted.
Gary Walter
