Team Roster Creator - Final Touches to Existing Code

This project has an initial code which is intended to create soccer teams based: 1. on days players are available for practice, 2. gender/league participant is in, 3. skill rating (1,2,3), 4. and school (SEE DBO_PLAYERS TABLE). I believe a programmer could rectify my problem in a minute once the module and table is reviewed. I simply want an Access form & print report feature that would allow me to select all the players in a particular league type (ex: FIU09, would mean females, in intramural, U-9 group. All parents inform us of the nights their children cannot play (negative database), then looks at rating, and school, to make sure there is a BALANCED team consisting of not too many players of one rating, and not too many players from one school. The school criteria segment is not in the code attached and below. I need help with this quickly, and asap. Your help would be GREATLY APPRECIATED. See Code needing help and revision below in deliverable: ## Deliverables Complete and fully-functional working program(s) in executable form as well as complete source code of all work done. Complete copyrights to all work purchased. Yes to above, understanding that code is already original from buyer of services. Requesting final revisions which become sole property of buyer once acceptable final form and league type print roster report capability utilizing ALL beforementioned player-team criterias. Option Compare Database Option Explicit Sub LeagueTeamSelector() Dim intDone As Integer Dim intTotPlayers As Integer Dim strLeague As String Dim intPlayerId As Integer Dim strSQL As String Dim blnWeekDone As Boolean Dim strRatingM As String Dim strRatingT As String Dim strRatingW As String Dim strRatingTH As String Dim strRatingF As String= Dim cnn As [login to view URL] Set cnn = [login to view URL] Dim rs As [login to view URL] Set rs = New [login to view URL] Dim cmd As [login to view URL] strLeague = InputBox("Enter League to Process") strSQL = "SELECT Count([login to view URL]) AS TotPlayers " & _ "FROM dbo_Players " & _ "WHERE [login to view URL] = '" & strLeague & "';" [login to view URL] strSQL, cnn, , , adCmdText intTotPlayers = rs("TotPlayers") [login to view URL] intDone = 0 blnWeekDone = False strRatingM = "1" strRatingT = "1" strRatingW = "1" strRatingTH = "1" strRatingF = "1" Do Until blnWeekDone 'Get a Monday player If strRatingM < 4 Then strSQL = "SELECT min(PlayerID) as Player " & _ "FROM dbo_Players " & _ "Where ((League = '" & strLeague & "') " & _ "AND (NOT Selected) " & _ "AND (M)) " & _ "AND Rating = '" & strRatingM & "'; " [login to view URL] strSQL, cnn, , , adCmdText If rs("Player") <> "Null" Then intPlayerId = rs("Player") strSQL = "UPDATE dbo_Players " & _ "SET [login to view URL] = Yes, " & _ "[login to view URL] = 'M' " & _ "WHERE ((([login to view URL])=" & rs("Player") & ")) ;" Set cmd = New [login to view URL] [login to view URL] = cnn [login to view URL] = strSQL [login to view URL] Else strRatingM = strRatingM + 1 End If [login to view URL] End If 'All Monday Records done 'Get a Tuesday player If strRatingT < 4 Then strSQL = "SELECT min(PlayerID) as Player " & _ "FROM dbo_Players " & _ "Where ((League = '" & strLeague & "') " & _ "AND (NOT Selected) " & _ "AND (T)) " & _ "AND Rating = '" & strRatingT & "'; " [login to view URL] strSQL, cnn, , , adCmdText If rs("Player") <> "Null" Then intPlayerId = rs("Player") strSQL = "UPDATE dbo_Players " & _ "SET [login to view URL] = Yes, " & _ "[login to view URL] = 'T' " & _ "WHERE ((([login to view URL])=" & rs("Player") & ")) ;" Set cmd = New [login to view URL] [login to view URL] = cnn [login to view URL] = strSQL [login to view URL] Else strRatingT = strRatingT + 1 End If [login to view URL] End If 'All Tuesday Records done 'Get a Wednesday player If strRatingW < 4 Then strSQL = "SELECT min(PlayerID) as Player " & _ "FROM dbo_Players " & _ "Where ((League = '" & strLeague & "') " & _ "AND (NOT Selected) " & _ "AND (W)) " & _ "AND Rating = '" & strRatingW & "'; " [login to view URL] strSQL, cnn, , , adCmdText If rs("Player") <> "Null" Then intPlayerId = rs("Player") strSQL = "UPDATE dbo_Players " & _ "SET [login to view URL] = Yes, " & _ "[login to view URL] = 'W' " & _ "WHERE ((([login to view URL])=" & rs("Player") & ")) ;" Set cmd = New [login to view URL] [login to view URL] = cnn [login to view URL] = strSQL [login to view URL] Else strRatingW = strRatingW + 1 End If [login to view URL] End If 'All Wednesday Records done 'Get a Thursday player If strRatingTH < 4 Then strSQL = "SELECT min(PlayerID) as Player " & _ "FROM dbo_Players " & _ "Where ((League = '" & strLeague & "') " & _ "AND (NOT Selected) " & _ "AND (TH)) " & _ "AND Rating = '" & strRatingTH & "'; " [login to view URL] strSQL, cnn, , , adCmdText If rs("Player") <> "Null" Then intPlayerId = rs("Player") strSQL = "UPDATE dbo_Players " & _ "SET [login to view URL] = Yes, " & _ "[login to view URL] = 'TH' " & _ "WHERE ((([login to view URL])=" & rs("Player") & ")) ;" Set cmd = New [login to view URL] [login to view URL] = cnn [login to view URL] = strSQL [login to view URL] Else strRatingTH = strRatingTH + 1 End If [login to view URL] End If 'All Thursday Records done 'Get a Friday player If strRatingF < 4 Then strSQL = "SELECT min(PlayerID) as Player " & _ "FROM dbo_Players " & _ "Where ((League = '" & strLeague & "') " & _ "AND (NOT Selected) " & _ "AND (F)) " & _ "AND Rating = '" & strRatingF & "'; " [login to view URL] strSQL, cnn, , , adCmdText If rs("Player") <> "Null" Then intPlayerId = rs("Player") strSQL = "UPDATE dbo_Players " & _ "SET [login to view URL] = Yes, " & _ "[login to view URL] = 'F' " & _ "WHERE ((([login to view URL])=" & rs("Player") & ")) ;" Set cmd = New [login to view URL] [login to view URL] = cnn [login to view URL] = strSQL [login to view URL] Else strRatingF = strRatingF + 1 End If [login to view URL] End If 'All Friday Records done 'Check to see if we have processed all the records from all the days. 'Each rating will be = 4 if we have. If strRatingM + strRatingT + strRatingW + strRatingTH + strRatingF = "44444" Then blnWeekDone = True End If Loop End Sub ## Deadline information I would like the code below to be done asap for registration season Sooner better than later, so i can test, and verify its workings...