Automatically Assign ID Number to Set of Records and Loop Until End

Anonymous
2010-11-14T17:08:07+00:00

I am a beginner so any assistance I receive will need to be specific with examples. I can't yet go from the abstract idea and turn that into hard code.

I have two queries (separate because I do not know how to make them into one). The first query exports the top 30 records into a table, then I manually run the second query to update the source table with the resultant ID number. I have thousands of records and I'd like to be able to put code behind a button that:

  • Assigns the top 30 records and does the SELECT INTO (Instead of the prompt the user will choose the city name from a combo box which I now know how to design.)
  • Updates the source table with the ID number
  • Loops until the end but on the last record assign ALL remaining records to the last ID number.  I have already determined exactly how many records need to be created manually. I have a report that tells me how many ID numbers I will need based on dividing the recordset into 30. I then bulk create those IDs.

BONUS: Have Access determine how many IDs I need and then assign the records and create the exports as text files with the name 'export1', 'export2' or 'export' & 'resultantidnumber', etc.

qryEXPStreetsandTrips:

SELECT TOP 30 tblSurveyData.SurveyID, tblSurveyData.FullName, IIf(tblSurveyData.Address2="1/2",[StNumber] & " " & [Address2] & " " & tblSurveyData.StName,[tblSurveyData].[StNumber] & " " & [tblSurveyData].[StName]) AS Address, IIf([tblSurveyData].[Apt?]=-1,"Apt. ",IIf([tblSurveyData].[Room?]=-1,"Room ",IIf([tblSurveyData].[Studio?]=-1,"Studio ",IIf([tblSurveyData].[Suite?]=-1,"Suite ",IIf([tblSurveyData].[Unit?]=-1,"Unit ",IIf([tblSurveyData].[Space?]=-1,"Space ",IIf([tblSurveyData].[Lot?]=-1,"Lot ",IIf([tblSurveyData].[Bldg?]=-1,"Bldg ",IIf([tblSurveyData].[Floor?]=-1,"Floor ",Null))))))))) & [Address2] AS Addr2, tblCity.City, tblSurveyData.Zip, CLng([Enter the territoryID to assign:]) AS TerritoryID INTO EXPStreetsandTrips

FROM tblSurveyData LEFT JOIN tblCity ON tblSurveyData.CityID = tblCity.CityID

WHERE (((tblCity.City) Like [Enter the city name:] & "*") AND ((tblSurveyData.TerritoryID)=106) AND ((tblSurveyData.TerritoryTypeID)=3))

ORDER BY tblSurveyData.Zip, tblSurveyData.Latitude;

qrySurveyData SET Survey (I have to wait a few seconds until the EXPStreetsandTrips is created before launching this query or it won't work, of course):

UPDATE tblSurveyData INNER JOIN EXPStreetsandTrips ON tblSurveyData.SurveyID=EXPStreetsandTrips.SurveyID SET tblSurveyData.TerritoryID = [EXPStreetsandTrips].[TerritoryID]

WHERE (((tblSurveyData.TerritoryID)=106) And ((tblSurveyData.SurveyID)=EXPStreetsandTrips.SurveyID) And ((tblSurveyData.TerritoryTypeID)=3));

Microsoft 365 and Office | Access | For home | Windows

Locked Question. This question was migrated from the Microsoft Support Community. You can vote on whether it's helpful, but you can't add comments or replies or follow the question.

0 comments
Answer accepted by question author
HansV 462.7K Reputation points MVP Volunteer Moderator
2010-11-17T19:18:13+00:00

Here is a new version that exports text files. Before testing it, change the export path in the variable strPath. It MUST end in a backslash.

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

  Dim lngTerritoryNumber As Long

  Dim f As Integer

  Dim strPath As String

  Dim strLine As String

  Dim strDelimiter As String

  On Error GoTo ErrHandler

  ' Change these as needed

  ' Batch size

  lngBatchSize = 30

  ' Unassigned ID

  lngOldTerritoryID = 106

  ' Path for text files

  strPath = "C:\Surveys"

  ' Delimiter for text files

  strDelimiter = vbTab ' can also be ","

  ' Get some info

  strCongregationID = DLookup("CongregationID", "tblVar")

  strUserID = DLookup("UserID", "tblVar")

  strTerritoryName = Nz(Me.TerritoryName, InputBox("Please provide a name for the new territory"))

  ' Get number of unassigned survey records

  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

  f = FreeFile

  ' Get highest TerritoryNumber

  lngTerritoryNumber = Nz(DMax("TerritoryNumber", "tblTerritory", _

    "CityID=" & strCityID & " AND TerritoryTypeID=" & strTerritoryTypeID), 0)

  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

        ' Close previous text file

        If lngCurrentRecord > 1 Then

          Close #f

        End If

        ' Open new text file

        Open strPath & "Territory" & lngNewTerritoryID & ".txt" For Output As #f

      End If

    End If

    ' Assign territory

    rst.Edit

    rst!TerritoryID = lngNewTerritoryID

    rst.Update

    ' Build line for text file

    strLine = rst!SurveyID & strDelimiter & Chr(34) & rst!FullName & Chr(34) & _

      strDelimiter & Chr(34) & rst!StNumber & " "

    If rst!Address2 = "1/2" Then

      strLine = strLine & rst!Address2 & " "

    End If

    strLine = strLine & rst!StName & Chr(34) & strDelimiter & Chr(34)

    Select Case True

      Case rst![Apt?]

        strLine = strLine & "Apt. "

      Case rst![Room?]

        strLine = strLine & "Room "

      Case rst![Studio?]

        strLine = strLine & "Studio "

      Case rst![Suite?]

        strLine = strLine & "Suite "

      Case rst![Unit?]

        strLine = strLine & "Unit "

      Case rst![Space?]

        strLine = strLine & "Space "

      Case rst![Lot?]

        strLine = strLine & "Lot "

      Case rst![Bldg?]

        strLine = strLine & "Bldg "

      Case rst![Floor?]

        strLine = strLine & "Floor "

    End Select

    strLine = strLine & rst!Address2 & Chr(34) & strDelimiter & _

      Chr(34) & DLookup("City", "tblCity", "CityID=" & strCityID) & Chr(34) & _

      strDelimiter & rst!Zip & strDelimiter & lngNewTerritoryID

    ' Write line to file

    Print #f, strLine

    ' On to the next record

    rst.MoveNext

  Loop

ExitHandler:

  On Error Resume Next

  Close #f

  rst.Close

  rst2.Close

  Set dbs = Nothing

  Me.Requery

  Exit Sub

ErrHandler:

  MsgBox Err.Description, vbExclamation

  Resume ExitHandler

End Sub

Was this answer helpful?

0 comments

41 additional answers

Sort by: Newest
Most helpful Newest Oldest
  1. HansV 462.7K Reputation points MVP Volunteer Moderator
    2010-11-17T01:12:01+00:00

    I omitted the part that fills EXPStreetsandTrips and exports to text file because I wanted to concentrate on getting the assignment in batches of 30 working correctly.

    I'll try to post code for that tomorrow.

    The second part (updating tblSurveyData) is already taken care of by the code that I posted - it creates new territories and sets the new TerritoryID for the unassigned records in tblSurveyData in one go.

    Was this answer helpful?

    0 comments
  2. Anonymous
    2010-11-17T01:06:39+00:00

    Looks good and I can follow it.  But, I'm not seeing any reference to the original selection of the records and exporting them to the text file and updating the source table with the new number. I'm sure elements of it are in here but I want to make sure you remembered about this part (copied from previous code sample above):

    How much of the code below goes in there and where should I put it?

        ' Build INSERT SQL

        strSQL2 = "SELECT TOP " & lngBatchSize & " tblSurveyData.SurveyID, tblSurveyData.FullName, " & _

          "IIf(tblSurveyData.Address2='1/2',[StNumber] & ' ' & [Address2] & " & _

          "' ' & tblSurveyData.StName,[tblSurveyData].[StNumber] & ' ' & " & _

          "[tblSurveyData].[StName]) AS Address, IIf([tblSurveyData].[Apt?]=-1," & _

          "'Apt. ',IIf([tblSurveyData].[Room?]=-1,'Room ',IIf([tblSurveyData].[Studio?]=-1," & _

          "'Studio ',IIf([tblSurveyData].[Suite?]=-1,'Suite ',IIf([tblSurveyData].[Unit?]=-1," & _

          "'Unit ',IIf([tblSurveyData].[Space?]=-1,'Space ',IIf([tblSurveyData].[Lot?]=-1," & _

          "'Lot ',IIf([tblSurveyData].[Bldg?]=-1,'Bldg ',IIf([tblSurveyData].[Floor?]=-1," & _

          "'Floor ',Null))))))))) & [Address2] AS Addr2, tblCity.City, tblSurveyData.Zip, " & _

          lngNewTerritoryID & " AS TerritoryID INTO EXPStreetsandTrips " & _

          "FROM tblSurveyData LEFT JOIN tblCity ON tblSurveyData.CityID = tblCity.CityID " & _

          "WHERE tblSurveyData.CityID=" & strCityID & " AND tblSurveyData.TerritoryID=" & _

          lngOldTerritoryID & " AND tblSurveyData.TerritoryTypeID=" & lngTerritoryTypeID & _

          " ORDER BY tblSurveyData.Zip, tblSurveyData.Latitude"

        ' Fill table

        dbs.Execute strSQL2

        ' Export to text file

        DoCmd.TransferText acExportDelim, , "EXPStreetsandTrips", "Export" & n, True

        ' Built UPDATE SQL

        strSQL2 = "UPDATE tblSurveyData INNER JOIN EXPStreetsandTrips ON " & _

          "tblSurveyData.SurveyID=EXPStreetsandTrips.SurveyID SET tblSurveyData.TerritoryID=" & _

          lngNewTerritoryID & " WHERE tblSurveyData.TerritoryID=" & lngOldTerritoryID & _

          " AND tblSurveyData.SurveyID=EXPStreetsandTrips.SurveyID AND tblSurveyData.TerritoryTypeID=" & _

          lngTerritoryTypeID

        ' Update table

        dbs.Execute strSQL2

        ' Get record count for next round

        Set rst = dbs.OpenRecordset(strSQL1, dbOpenDynaset)

        rst.MoveLast

        rst.MoveFirst

        lngRecordCount = rst.RecordCount

        rst.Close

      Loop

      Set dbs = Nothing

    Was this answer helpful?

    0 comments
  3. HansV 462.7K Reputation points MVP Volunteer Moderator
    2010-11-17T00:39:33+00:00

    Try this version of the code for a "bulk assign" button on frmTerritory:

    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

    If the last batch would be less than half the standard batch size, it is added to the next-to-last batch.

    Was this answer helpful?

    0 comments
  4. HansV 462.7K Reputation points MVP Volunteer Moderator
    2010-11-16T23:14:15+00:00

    Thanks - I hadn't understood that 106 = unassigned. Let me look into it.

    Was this answer helpful?

    0 comments