Automatically Assign ID Number to Set of Records and Loop

[dfbrewer]

Continuation for Hans. How can I upload my file for only your eyes? I've stripped personal information but I don't want my code out there for all to see.

[HansV]

Hi Dana,

Welcome to Eileen's Lounge!

We generally prefer attachments to be available to anyone, but I'll send you a private message with information where you can send the file. Watch your private messages.

[HansV]

I have received your database and looked at it, but it's not clear to me where I should look for unassigned records. Could you explain? Thanks!

[HansV]

Here is some code you can use (also posted in Microsoft Answers)

Code: Select all

Private Sub cmdAssignTest_Click()
  Dim strCongregationID As String
  Dim strUserID As String
  Dim lngBatchSize As Long
  Dim lngOldTerritoryID As Long
  Dim lngNewTerritoryID As Long
  Dim dbs As DAO.Database
  Dim rst As DAO.Recordset
  Dim rst2 As Recordset
  Dim strSQL As String
  Dim lngRecordCount As Long
  Dim lngCurrentRecord As Long
  Dim strTerritoryName As String

  On Error GoTo ErrHandler

  lngBatchSize = 30
  lngOldTerritoryID = 106
  strCongregationID = DLookup("CongregationID", "tblVar")
  strUserID = DLookup("UserID", "tblVar")
  strTerritoryName = Me.TerritoryName

  strSQL = "SELECT * FROM tblSurveyData WHERE CityID=" & strCityID & _
    " AND TerritoryTypeID=" & strTerritoryTypeID & _
    " AND TerritoryID=" & lngOldTerritoryID
  Set dbs = CurrentDb
  Set rst = dbs.OpenRecordset(strSQL, dbOpenDynaset)
  If rst.EOF Then
    MsgBox "No records!", vbExclamation
    GoTo ExitHandler
  End If
  rst.MoveLast
  rst.MoveFirst
  lngRecordCount = rst.RecordCount

  ' Get highest TerritoryNumber
  lngTerritoryNumber = DMax("TerritoryNumber", "tblTerritory", _
    "CityID=" & strCityID & " AND TerritoryTypeID=" & strTerritoryTypeID)

  Set rst2 = dbs.OpenRecordset("tblTerritory", dbOpenDynaset)

  ' Loop
  lngCurrentRecord = 0
  Do While Not rst.EOF
    lngCurrentRecord = lngCurrentRecord + 1
    If lngCurrentRecord Mod lngBatchSize = 1 Then
      ' Do we have enough records left?
      If lngRecordCount - lngCurrentRecord >= lngBatchSize \ 2 _
          Or lngCurrentRecord = 1 Then
        ' Create new territory
        lngTerritoryNumber = lngTerritoryNumber + 1
        rst2.AddNew
        rst2!TerritoryNumber = lngTerritoryNumber
        rst2!TerritoryTypeID = strTerritoryTypeID
        rst2!CityID = strCityID
        rst2!CongregationID = strCongregationID
        rst2!EnteredBy = strUserID
        rst2!TerritoryName = strTerritoryName
        ' Remember new ID
        lngNewTerritoryID = rst2!TerritoryID
        rst2.Update
      End If
    End If
    ' Assign territory
    rst.Edit
    rst!TerritoryID = lngNewTerritoryID
    rst.Update
    rst.MoveNext
  Loop

ExitHandler:
  On Error Resume Next
  rst.Close
  rst2.Close
  Set dbs = Nothing
  Me.Requery
  Exit Sub

ErrHandler:
  MsgBox Err.Description, vbExclamation
  Resume ExitHandler
End Sub