Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations gkittelson on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Limiting a loop of EOF 1

Status
Not open for further replies.

AshleyM21

Technical User
Feb 12, 2013
3
GB
Hi I'm currently 'attempting' to code something that will automatically allocate a number of records to individuals listed in a resource table. I have managed to get the code to run the allocation based on priority and role, but am struggling to limit the number of records allocated per individual.

Current code:

Sub AssignBMWorkflowC()

Dim rstResources As DAO.Recordset, rstWorkflow As DAO.Recordset
Dim strSQL As String

' Create a list of all records in tbl_Workflow where the Allocated_ID field is empty
strSQL = "SELECT * FROM tbl_Workflow WHERE Allocated_ID Is Null AND [Activity]='Outbound Call';"
Set rstWorkflow = CurrentDb.OpenRecordset(strSQL)

' Make sure there is work to assign
If rstWorkflow.RecordCount > 0 Then
rstWorkflow.MoveFirst

' Get a randomized list of all reviewers
strSQL = "SELECT * FROM [tbl_Resources] WHERE [ROLE]= 'Caller' ORDER BY Rnd([NameID]);"
Set rstResources = CurrentDb.OpenRecordset(strSQL)

' Make sure there are reviewers to assign to Calls
If rstResources.RecordCount > 0 Then
rstResources.MoveFirst

' Loop through all of the work
While Not rstWorkflow.EOF
' Assign the current reviewer to high priority work items
rstWorkflow.Edit
rstWorkflow.Fields("Allocated_ID") = rstResources.Fields("NameID")
rstWorkflow.Update
' Move to the next workitem
rstWorkflow.MoveNext

' Go to the next reviewer
On Error Resume Next
rstResources.MoveNext
On Error GoTo 0
' Re-start the list of reviewers, if necessary
If rstResources.EOF Then
rstResources.MoveFirst
End If
Wend

Else
MsgBox "There are no Callers assigned to workflow"
End If

Else
MsgBox "Error! There are no High priority Call activites in the workflow"
End If
End Sub

Appriciate any help
 
Sorry, I don't have time to review the logic but did have time to reformat your code with TGML to make it easier to read.

Code:
Sub AssignBMWorkflowC()
 
   Dim rstResources As DAO.Recordset, rstWorkflow As DAO.Recordset
   Dim strSQL As String

   [COLOR=#4E9A06]' Create a list of all records in tbl_Workflow where the Allocated_ID field is empty[/color]   strSQL = "SELECT * FROM tbl_Workflow WHERE Allocated_ID Is Null AND [Activity]='Outbound Call';"
   Set rstWorkflow = CurrentDb.OpenRecordset(strSQL)

   [COLOR=#4E9A06]' Make sure there is work to assign[/color]
   If rstWorkflow.RecordCount > 0 Then
      rstWorkflow.MoveFirst
 
      [COLOR=#4E9A06]' Get a randomized list of all reviewers[/color]
      strSQL = "SELECT * FROM [tbl_Resources] WHERE [ROLE]= 'Caller' ORDER BY Rnd([NameID]);"
      Set rstResources = CurrentDb.OpenRecordset(strSQL)

      [COLOR=#4E9A06]' Make sure there are reviewers to assign to Calls[/color]
      If rstResources.RecordCount > 0 Then
         rstResources.MoveFirst

         [COLOR=#4E9A06]' Loop through all of the work[/color]
         While Not rstWorkflow.EOF
            [COLOR=#4E9A06]' Assign the current reviewer to high priority work items[/color]
            rstWorkflow.Edit
            rstWorkflow.Fields("Allocated_ID") = rstResources.Fields("NameID")
            rstWorkflow.Update
            [COLOR=#4E9A06]' Move to the next workitem[/color]
            rstWorkflow.MoveNext

            [COLOR=#4E9A06]' Go to the next reviewer[/color]
            On Error Resume Next
            rstResources.MoveNext
            On Error GoTo 0
            [COLOR=#4E9A06]' Re-start the list of reviewers, if necessary[/color]
            If rstResources.EOF Then
               rstResources.MoveFirst
            End If
         Wend
       Else
         MsgBox "There are no Callers assigned to workflow"
      End If
    Else
      MsgBox "Error! There are no High priority Call activites in the workflow"
   End If
End Sub

Duane
Hook'D on Access
MS Access MVP
 

Code:
' Loop through all of the work
While Not rstWorkflow.EOF
' Assign the current reviewer to high priority work items
  rstWorkflow.Edit
  rstWorkflow.Fields("Allocated_ID") = getNextName(rstResources)
  rstWorkflow.Update
' Move to the next workitem
rstWorkflow.MoveNext


Private Function GetNextName(rstResources As DAO.Recordset) As Integer
  If Not (rstResources.EOF And rstResources.BOF) Then
    If rstResources.EOF Then rstResources.MoveFirst
    GetNextName = rstResources!nameID
    rstResources.MoveNext
  End If
End Function
 
Another way:
Code:
Sub AssignBMWorkflowC()
Dim rstResources As DAO.Recordset, rstWorkflow As DAO.Recordset
Dim strSQL As String
[!]Const iMax = 3
Dim iCur As Integer[/!]
' Create a list of all records in tbl_Workflow where the Allocated_ID field is empty
strSQL = "SELECT * FROM tbl_Workflow WHERE Allocated_ID Is Null AND [Activity]='Outbound Call';"
Set rstWorkflow = CurrentDb.OpenRecordset(strSQL)
' Make sure there is work to assign
If rstWorkflow.RecordCount > 0 Then
  rstWorkflow.MoveFirst
  ' Get a randomized list of all reviewers
  strSQL = "SELECT * FROM [tbl_Resources] WHERE [ROLE]= 'Caller' ORDER BY Rnd([NameID]);"
  Set rstResources = CurrentDb.OpenRecordset(strSQL)
    ' Make sure there are reviewers to assign to Calls
  If rstResources.RecordCount > 0 Then
    rstResources.MoveFirst
    ' Loop through all of the work
    [!]iCur = 1[/!]
    While Not rstWorkflow.EOF
      ' Assign the current reviewer to high priority work items
      rstWorkflow.Edit
      rstWorkflow.Fields("Allocated_ID") = rstResources.Fields("NameID")
      rstWorkflow.Update
      ' Move to the next workitem
      rstWorkflow.MoveNext
      ' Go to the next reviewer
      On Error Resume Next
      rstResources.MoveNext
      On Error GoTo 0
      ' Re-start the list of reviewers, if necessary
      If rstResources.EOF Then
        [!]iCur = iCur + 1
        If iCur > iMax Then
          MsgBox "Too much allocations per individual"
          Exit Sub
        End If[/!]
        rstResources.MoveFirst
      End If
    Wend
  Else
    MsgBox "There are no Callers assigned to workflow"
  End If
Else
  MsgBox "Error! There are no High priority Call activites in the workflow"
End If
End Sub

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
Sorry don't follow the code change here and showing my lack of VBA skills, but I don't get how you limit the number of records updated for each resource ID (ie I wouldn't want any more than 50 items of work per individual).
 
are assigning everyone the same amount, but in random order? Or are you assigning a random amount up to a specified limit?
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top