How to update identical records on table?

[pds8475]

Hi
I have a Query and a form which shows records on a table where a Table field matches a field on a subform(ATRNumber). The records outputted by the query are mainly identical records.

I want to be able to add a unique string(generated by a DO Loop based on a count of records with matching ATRNumbers) to a blank field of these records.

 Private Sub Command8_Click()
Dim Total As Integer
Dim Num As String
Dim Prefix As String
Dim BC As String
Dim ZC As String
Dim zeros As String
Dim lngNumberOfCharacters As Long
 Total = Forms!FrmStoresDueIn!ATRSubform!CountOfATRNumber
Num = Me.BarTxt
Prefix = Me.PrefixCombo.Value
lngNumberOfCharacters = Len(BarTxt)
 If (lngNumberOfCharacters = 3) Then
     Do
       
        ZC = ThreeDigit(ZC)
        BC = Prefix + ZC
      '  SQL = "UPDATE DueInTable " & _
       '   "SET [BarCode] = " & BC & _
       '   " WHERE [ATRNumber] = Form!FrmStoresDueIn!ATRSubform!ATRNumber"
      '  DoCmd.RunSQL SQL
        Total = Total - 1
    Loop Until Total = 0
 
 
 End If
 End Sub
  
  
  
 Public Function ThreeDigit(ByVal strSource As String, Optional ByVal strFormat As String = "000")
     ThreeDigit = Format(Val(strSource) + 1, strFormat)
 End Function

I have seen examples of where you can go to next records till the end of file. But this would be no use as the table holds records that have different ATRNumbers.

Any help would be greatly appreciated.

 

[arnelgp]

Private Sub Command8_Click()
    Dim Total As Integer
    Dim Num As String
    Dim Prefix As String
    Dim BC As String
    Dim ZC As String
    Dim zeros As String
    Dim lngNumberOfCharacters As Long
    Dim rs As DAO.Recordset
    Total = Forms!FrmStoresDueIn!ATRSubform!CountOfATRNumber
    Num = Me.BarTxt
    Prefix = Me.PrefixCombo.Value
    lngNumberOfCharacters = Len(BarTxt)
     If (lngNumberOfCharacters = 3) Then
        Set rs = Forms!FrmStoresDueIn!ATRSubform.Form.RecordsetClone
        With rs
            If Not (.BOF And .EOF) Then .MoveFirst
            ZC = ThreeDigit(ZC)
            BC = Prefix + ZC
            While Not .EOF
                .Edit
                ![barcode] = BC
                .Update
                DBEngine.Idle dbFreeLocks
                .MoveNext
                DoEvents
            Wend
        End With
        Set rs = Nothing
     End If
 End Sub

 

[pds8475]

I am getting runtime error 3027 Cant update, Database or object is read only. From looking up the error code it appears that this is due to the subform being based on a query rather than a table. So the Recordsetclone is read only. The table it self is called DueInTable.

 

[arnelgp]

Private Sub Command8_Click()
    Dim Num As String
    Dim Prefix As String
    Dim BC As String
    Dim ZC As String
    Dim zeros As String
    Dim lngNumberOfCharacters As Long
    Dim strSQL As String
    Dim rs As DAO.Recordset
    Num = Me.BarTxt
    Prefix = Me.PrefixCombo.Value
    lngNumberOfCharacters = Len(BarTxt)
     If (lngNumberOfCharacters = 3) Then
        ' if ATRNumber is text
        strSQL = "Select [BarCode] From DueInTable Where [ATRNumber] = '" & Form!FrmStoresDueIn!ATRSubform!ATRNumber & "'"
        
        ' else uncomment below if ATRNumber is numeric
        ' strSQL = "Select [BarCode] From DueInTable Where [ATRNumber] = " & Form!FrmStoresDueIn!ATRSubform!ATRNumber
        
        Set rs = DBEngine(0)(0).OpenRecordset(strSQL, dbOpenDynaset)
        With rs
            If Not (.BOF And .EOF) Then .MoveFirst
            ZC = ThreeDigit(ZC)
            BC = Prefix + ZC
            While Not .EOF
                .Edit
                ![barcode] = BC
                .Update
                DBEngine.Idle dbFreeLocks
                .MoveNext
                DoEvents
            Wend
        End With
        Set rs = Nothing
     End If
 End Sub

 

[pds8475]

Thanks that's brilliant. Just needed do a couple of minor changes to get it to do exactly what I want.

 Private Sub Command8_Click()
Dim Total As Integer
Dim Num As String
Dim Prefix As String
Dim BC As String
Dim ZC As String
Dim zeros As String
Dim lngNumberOfCharacters As Long
Dim rs As DAO.Recordset
 
Total = Forms!FrmStoresDueIn!ATRSubform!CountOfATRNumber
Num = Me.BarTxt
Prefix = Me.PrefixCombo.Value
lngNumberOfCharacters = Len(BarTxt)
ZC = Num - 1
 If (lngNumberOfCharacters = 3) Then
        ' if ATRNumber is text
        strSQL = "Select [BarCode] From DueInTable Where [ATRNumber] = '" & Forms!FrmStoresDueIn!ATRSubform!ATRNumber & "'"
        
        ' else uncomment below if ATRNumber is numeric
        ' strSQL = "Select [BarCode] From DueInTable Where [ATRNumber] = " & Form!FrmStoresDueIn!ATRSubform!ATRNumber
        
        Set rs = DBEngine(0)(0).OpenRecordset(strSQL, dbOpenDynaset)
        With rs
            If Not (.BOF And .EOF) Then .MoveFirst
           
            While Not .EOF
             ZC = ThreeDigit(ZC)
            BC = Prefix + ZC
                .Edit
                ![Barcode] = BC
                .Update
                DBEngine.Idle dbFreeLocks
                .MoveNext
                DoEvents
            Wend
        End With
        Set rs = Nothing
  
 End If
  
 End Sub

 

[arnelgp]

glad you figured it out. happy coding!