Using VBA to loop through a query and outputting results

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.

You don't want to just do this in the query itself? You can use iif() in a query, you shouldn't need to use VBA — Scotch
– Scotch, Commented Jun 4, 2013 at 18:42
Well yes, if I was just doing this in a small amount, but then going through tons of stats in using a query takes time, especially when I will then go through and do the same thing to multiple sports. So that is highly inefficient. — Chris Jones
– Chris Jones, Commented Jun 4, 2013 at 18:43
I don't see how iterating a recordset in VBA is going to be any faster. It's going to be doing the same thing regardless. — Scotch
– Scotch, Commented Jun 4, 2013 at 18:46
Lets say I am doing something like this for 40 stats.. not that I can think of 40 stats , but either way, it shouldn't be that hard to creat some VBA that would basically create a variable that would fit into the Name of the columnn and then indicate to go after all records after the fact and apply that same formula to each column. Although..I don't have the knowledge to do so and I have tried looking it up. — Chris Jones
– Chris Jones, Commented Jun 4, 2013 at 18:47
@Chris, it sounds like you want to make an 'elegant` query that is free from all these pesky details which are hidden away in a custom VBA function. It's a good goal, but not always worthwhile. Try this: Just make a 'formatting layer' query that has all this ugly code in it. Then make other queries that pull from this 'formatting layer' query. THESE queries will be clean and simple like you want. — PowerUser
– PowerUser, Commented Jun 4, 2013 at 19:20

Johnny Bones · Accepted Answer · 2013-06-06 14:15:02Z

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

answered Jun 6, 2013 at 14:15

Johnny Bones

8,4927 gold badges61 silver badges127 bronze badges

Sign up to request clarification or add additional context in comments.

6 Comments

Chris Jones Over a year ago

If I may ask, do you know of a good book to use to learn VBA? Just wondering. It would be nice if I could so that maybe I could be more helpful when asking questions. Thanks!! ANyways, Let me see how this works.

Johnny Bones Over a year ago

Try one of the SAMS Publishing books. The only book I ever bought was Access 97 Unleashed. Other than that, it's been co-workers, trial & error and a whole lotta Google. :o)

Chris Jones Over a year ago

haha, I've done that whole lotta google thing. Its helped some.. as has this sight. However, this just went way up there.. and I have no way to just "google" it.

Chris Jones Over a year ago

After Testing it, it seems to almost work, but it says that PlayerSal is read only and points to rec.edit... not sure if that is somethings simple on my end, but if it throws everything off, then thanks anyways.

Johnny Bones Over a year ago

It worked for me, not sure why your table is read-only. Like I said, the only thing that needed tweaking was that it would only process the first record in the table, so somewhere there has to be a loop with a rec.movenext so that it goes through every record. If the tables are actually linked SQL tables then you probably need a key field, other than that I don't know.

|

Johnny Bones · Accepted Answer · 2013-06-05 14:23:39Z

0

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.

answered Jun 5, 2013 at 14:23

Johnny Bones

8,4927 gold badges61 silver badges127 bronze badges

5 Comments

Chris Jones Over a year ago

This is actually close to looking like something I wanted Basically, I wanted to do this and then output it as a query.

Johnny Bones Over a year ago

Then add a CreateQuerydef statement and you got it. :o)

Chris Jones Over a year ago

I did try that.. and it told me, "Variable required, can't assign to this expression." That was in reference to the Fld.name in the For each statement.

Johnny Bones Over a year ago

I know there's a way to do that, but I can't think of it off the top of my head and I'm wrapped up in a project at work I gotta get done. But I had a feeling that part wasn't right. :o( Tinker with this: p2p.wrox.com/access-vba/…

Chris Jones Over a year ago

Thanks for trying man. I appreciate you actually putting help towards what I am getting at. Although I am still confused mostly... but I am better to get better picture of how to do this.

Johnny Bones · Accepted Answer · 2013-06-05 20:00:33Z

0

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

answered Jun 5, 2013 at 20:00

Johnny Bones

8,4927 gold badges61 silver badges127 bronze badges

1 Comment

Chris Jones Over a year ago

So should I put them in the same Module? I ran this in one module after changing tblPlayers to PlayerSal and I got no errors..only I didn't see anything happen. Still, its a start. Again, I really really really appreciate your help. It seems I found something that might push other people too, which is good I suppose.

Collectives™ on Stack Overflow

Using VBA to loop through a query and outputting results

3 Answers 3

6 Comments

5 Comments

1 Comment

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

3 Answers 3

6 Comments

5 Comments

1 Comment

Your Answer

Sign up or log in

Post as a guest

Related