Using VBA to loop through a query and outputting results - sql

Question

So what I have here is a query that displays a Baseball players Name, Salary, and then shows normal baseball stats such as Hits, RBIs, etc. What I want to is have the code create a query at the end that will contain the player's name and and the result of an expression that looks like
IIf([H]<>0,Format(([Salary]/[H]),'$#,###.##'),0) AS Per_H
I basically want to be able to make it apply that formula to every column after their name and salary.
Right now I have
Table PlayerSal
NAME SALARY H R HR
With H being Hits, R being Runs, and HR being Homeruns.
My resulting query that I want should look like this.
Player_Per
NAME Per_H, Per_R, Per_HR.
What exactly do I need to do?
Edit
I should add, yes, I know I can just input that very same function for each stat that I want to calculate it for, that isn't the point. I am trying to expand my knowledge while applying it to something that I find interesting. However, I know that this could probably be expanded to other things down the road.

Answer 1

Sorry, brother. Last shot. This code works. However, it needs a small tweak because it doesn't loop through all the records.
Public Function HitTest()
Dim db As Database
Dim rec As DAO.Recordset
Dim fld As DAO.Field
Set db = CurrentDb
Set rec = db.OpenRecordset("tblPlayers")
EditTable = "tblPlayers"
For Each fld In rec.Fields
If fld.Name <> "PName" And fld.Name <> "Salary" And Left(fld.Name, 4) <> "Per_" Then
strFieldName = "Per_" & fld.Name & ""
'rs.Fields (strFieldName)
'X = "IIf(rec([" & fld.Name & "]) <> 0, Format((rec([Salary]) / rec([" & fld.Name & "])), '$#,###.##'), 0)"
If FieldExists(EditTable, strFieldName) Then
Else
'AltTable = "ALTER TABLE " & EditTable & " ADD COLUMN " & strFieldName & " Double;"
'CurrentDb.Execute (AltTable)
End If
rec.Edit
X = IIf(rec((fld.Name)) <> 0, Format((rec("Salary") / rec((fld.Name))), "$#,###.##"), 0)
rec.Fields(strFieldName).Value = X
rec.Update
End If
Next fld
End Function

Answer 2

I'm sure I'm not understanding the question, but you could do something like this:
Dim db as database
dim rec as recordset
Dim fld as Field
Set db = CurrentDB
Set rec = db.OpenRecordset("PlayerSal")
For each Fld.name in rec
If Fld.Name <> "Name" and Fld.Name <> "Salary" then
Per_" & Fld.Name & " = IIf([" & Fld.Name & "]<>0,Format(([Salary]/[" & Fld.Name & "]),'$#,###.##'),0)
End If
Next Fld.Name
The above is ENTIRELY "aircode" and more than likely won't work out of the box, but hopefully it gives you an idea.

Answer 3

I did a little more research on this. Looks like you'll need to open a recordset to make sure all your "Per_" fields exist and determine any new fields you need to add. Then you need to close the recordset and run ALTER TABLE statements to create any new fields you need. Then you need to re-open the recordset and update your fields with the value of your formula.
You can probably eliminate the first 2 steps if you just add the new fields manually, but that's how you would have to do it. If you wanted to eliminate those first 2 steps, you'd end up with something like this:
Dim db As Database
Dim rec As DAO.Recordset
Dim fld As DAO.Field
Set db = CurrentDb
Set rec = db.OpenRecordset("tblPlayers")
EditTable = "tblPlayers"
For Each fld In rec.Fields
If fld.Name <> "PName" And fld.Name <> "Salary" Then
strFieldName = "Per_" & fld.Name & ""
X = "IIf([" & fld.Name & "] <> 0, Format(([Salary] / [" & fld.Name & "]), '$#,###.##'), 0)"
If FieldExists(EditTable, strFieldName) Then
rec.Edit
rec.Fields(strFieldName).Value = X
rec.Update
Else
End If
End If
Next fld
Then you need this function to check if the field exists:
Public Function FieldExists(ByVal tableName As String, ByVal fieldName As String) As Boolean
Dim nLen As Long
On Error GoTo Failed
With DBEngine(0)(0).TableDefs(tableName)
.Fields.Refresh
nLen = Len(.Fields(fieldName).Name)
If nFldLen > 0 Then FieldExists = True
End With
Exit Function
Failed:
If Err.Number = 3265 Then Err.Clear ' Error 3265 : Item not found in this collection.
FieldExists = False
End Function