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-14T19:40:49+00:00

    The following is "air code", I can't really test it. I'd backup everything before testing it!

    Sub ExportBatches()

      Dim lngBatchSize As Long

      Dim strCity As String

      Dim lngOldTerritoryID As Long

      Dim lngNewTerritoryID As Long

      Dim lngTerritoryTypeID As Long

      Dim dbs As DAO.Database

      Dim rst As DAO.Recordset

      Dim n As Long

      Dim lngRecordCount As Long

      Dim strSQL1 As String

      Dim strSQL2 As String

      ' Fixed parameters

      lngBatchSize = 30

      lngOldTerritoryID = 106

      lngTerritoryTypeID = 3

      ' Variable parameters

      strCity = InputBox("Enter the city")

      Set dbs = CurrentDb

      strSQL1 = "SELECT Count(*) AS RecCount FROM tblSurveyData LEFT JOIN tblCity ON " & _

        "tblSurveyData.CityID = tblCity.CityID " & _

        "WHERE tblCity.City Like '" & strCity & "*' AND tblSurveyData.TerritoryID=" & _

        lngOldTerritoryID & " AND tblSurveyData.TerritoryTypeID=" & lngTerritoryTypeID

      ' Compute record count

      Set rst = dbs.OpenRecordset(strSQL1, dbOpenDynaset)

      rst.MoveLast

      rst.MoveFirst

      lngRecordCount = rst.RecordCount

      rst.Close

      Do While lngRecordCount > 0

        n = n + 1

        ' Ask for new territory ID

        lngNewTerritoryID = CLng(InputBox("Enter the new territory ID"))

        ' 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 tblCity.City Like '" & strCity & "*' 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

    End Sub

    Was this answer helpful?

    0 comments
  2. Anonymous
    2010-11-14T17:46:15+00:00

    That's fine. I can let the user manually add the remaining records to the last one before they continue with the next step. Thhey have a report that will show them how many unassigned records remain for each city and type. If I can somehow automate the majority of this process (as bulleted above) it would represent a HUGE time savings.

    Was this answer helpful?

    0 comments
  3. HansV 462.7K Reputation points MVP Volunteer Moderator
    2010-11-14T17:30:57+00:00

    If you process the records in batches of 30, the remainder at the end would be 4, not 34, for the processing would continue as long as there are 30 or more records left...

    Was this answer helpful?

    0 comments
  4. Anonymous
    2010-11-14T17:22:36+00:00

    Correct; I want to loop until no records remain unprocessed where records match the cityid (chosen by user), territoryid=106, and territorytypeid=3.

    You actually gave me the code to bulkadd territories. I would rather this be all one process. User clicks CREATE NEW SURVEYS and Access reads the source data, assigns records to territories (and creates said territory), exports to text file (preferred even though now it exports to table that is overwritten each time because I don't know how to give each one a different name automatically) and loops until there are none remaining. For example is 34 records remain I'd like to put all 34 on the very last territory.

    Was this answer helpful?

    0 comments