CODEWITHSUNDEEP
databasems-accessvbams-access-2010
DeclanPossnett
DeclanPossnett

Reputation: 376

vba loop through fields in recordset while another recordset is not EOF

I am writing some code for an access database (Access 2010) and need to extract non-empty fields from a table into another (tbl_TempProducts to tbl_BrandsStocked). Whilst doing this the row with the fields I want to 'copy and paste' from needs to be split into various rows of another table. The first value of the record in tbl_TempProducts should be used as the first value in every new record in tbl_BrandsStocked as long as the values being transferred are in the same record as the record we are transferring from. I want to create a new record in tbl_BrandsStocked for every 7th field in tbl_TempProducts.

Please see Diagram provided HERE

The code works but the order in which it 'pastes' the code into the destination table is incorrect.

Please forgive me if this is not clear enough as this is my first post!

I will post more information if needed.. :)

Please see code below:

Private Sub btnTransfer_Click()

Dim dbs As DAO.Database
Dim temp As DAO.Recordset
Dim bStocked As DAO.Recordset

Dim fld As DAO.Field

Dim AutoID As String
Dim Product As String
Dim varProd As String
Dim PackSize As String
Dim priceType As String
Dim casesSold As String

Dim accountNumber As Integer
Dim firstRun As Boolean
Dim counter As Integer


Set dbs = CurrentDb
Set temp = dbs.OpenRecordset("SELECT * FROM tbl_TempProducts WHERE id IS NOT NULL")
Set bStocked = dbs.OpenRecordset("SELECT * FROM tbl_BrandsStocked")

counter = 0
firstRun = True

temp.MoveFirst

Do While temp.EOF = False


    For Each fld In temp.Fields

        If fld.Name <> "" Then

            If counter = 1 Then
                    AutoID = Nz(fld.value, "")

                If AutoID <> "" Then
                    AutoID = Nz(fld.value, "")
                    bStocked.AddNew
                    bStocked!AccountNo = AutoID
                    bStocked.upDate

                    If accountNumber <> AutoID Then
                        On Error Resume Next
                        accountNumber = AutoID
                    End If
                Else
                    counter = counter - 1
                End If

            ElseIf counter = 2 Then
                Product = Nz(fld.value, "")

                If Product <> "" Then
                    bStocked.MoveLast
                    bStocked.Edit
                    bStocked!Brand = Product
                    bStocked.upDate
                Else
                    counter = counter - 1
                End If

            ElseIf counter = 3 Then
                varProduct = Nz(fld.value, "")

                If varProduct <> "" Then
                    bStocked.MoveLast
                    bStocked.Edit
                    bStocked!Variation = varProduct
                    bStocked.upDate
                Else
                    counter = counter - 1
                End If

            ElseIf counter = 4 Then
                PackSize = Nz(fld.value, "")

                If PackSize <> "" Then
                    bStocked.MoveLast
                    bStocked.Edit
                    bStocked!PackSize = PackSize
                    bStocked.upDate
                Else
                    counter = counter - 1
                End If

            ElseIf counter = 5 Then
                priceType = Nz(fld.value, "")

                If priceType <> "" Then
                    bStocked.MoveLast
                    bStocked.Edit
                    bStocked![RRP-PMP] = priceType
                    bStocked.upDate
                Else
                    counter = counter - 1
                End If

            ElseIf counter = 6 Then
                casesSold = Nz(fld.value, "")

                If casesSold <> "" Then
                    bStocked.MoveLast
                    bStocked.Edit
                    bStocked!CPW = casesSold
                    bStocked.upDate
                Else
                    counter = counter - 1
                End If
            End If
        End If

    counter = counter + 1

            If counter >= 7 Then
                counter = 2
                bStocked.AddNew
                bStocked!AccountNo = accountNumber
                bStocked.upDate
            End If

    Next

    temp.MoveNext

    counter = 0
    firstRun = True

Loop

DoCmd.SetWarnings False
DoCmd.RunSQL "DELETE * FROM [tbl_BrandsStocked] WHERE [Brand] Is null"
DoCmd.SetWarnings True

Set dbs = Nothing
Set temp = Nothing
Set bStocked = Nothing
Set fld = Nothing

End Sub

Upvotes: 3

Views: 17564

Answers (2)

Andre
Andre

Reputation: 27634

In addition to posting sample data, you should review your code:

  • You start with counter = 0, but don't have a case for this, so the first field will always be ignored. Intentionally?
  • firstRun is set but never used
  • Instead of all the bStocked.MoveLast, .Edit, .Update you should have one current record in bStocked that you write to. This would make your code much better readable.

Edit

I suggest a structure like this:

strValue = Nz(fld.value, "")
If strValue <> "" Then
    Select Case counter
        Case 1: accountNumber = Val(strValue)   ' add error handling!
                bStocked.AddNew
                bStocked!AccountNo = accountNumber
        Case 2: bStocked!Brand = strValue       ' Product
        Case 3: bStocked!Variation = strValue   ' varProduct
        ' etc 4..6
    End Select
    counter = counter + 1

    If counter >= 7 Then
        bStocked.upDate     ' save new record

        bStocked.AddNew
        bStocked!AccountNo = accountNumber
        counter = 2
    End If
Else
    ' For an empty field you simply move to the next field
End If

Next fld
' save last record
bStocked.upDate

Upvotes: 0

DeclanPossnett
DeclanPossnett

Reputation: 376

I have solved this problem now. The main reason I was getting incorrect values in the destination table was because using the "accountNumber" variable was not necessary. Instead I used the "AutoID" variable value as the first field on the destination table when looping through the code.

Very simple fix but it did take me a while unfortunately, hence the reason for posting as I needed an extra pair of eyes!

Working Code:

Private Sub btnTransfer_Click()

Dim dbs As DAO.Database
Dim temp As DAO.Recordset
Dim bStocked As DAO.Recordset

Dim fld As DAO.Field

Dim AutoID As String
Dim Product As String
Dim varProd As String
Dim PackSize As String
Dim priceType As String
Dim casesSold As String

Dim accountNumber As Integer
Dim counter As Integer


Set dbs = CurrentDb
Set temp = dbs.OpenRecordset("SELECT * FROM tbl_TempProducts WHERE id IS NOT NULL")
Set bStocked = dbs.OpenRecordset("SELECT * FROM tbl_BrandsStocked")

counter = 0
firstRun = True
accountNumber = 0
AutoID = 0

temp.MoveFirst

Do While temp.EOF = False


    For Each fld In temp.Fields

        If fld.Name <> "" Then

            If counter = 1 Then
                    AutoID = Nz(fld.value, "")

                If AutoID <> "" Then
                    AutoID = Nz(fld.value, "")
                    bStocked.AddNew
                    bStocked!AccountNo = AutoID
                    bStocked.upDate
                Else
                    counter = counter - 1
                End If

            ElseIf counter = 2 Then
                Product = Nz(fld.value, "")

                If Product <> "" Then
                    bStocked.MoveLast
                    bStocked.Edit
                    bStocked!Brand = Product
                    bStocked.upDate
                Else
                    counter = counter - 1
                End If

            ElseIf counter = 3 Then
                varProduct = Nz(fld.value, "")

                If varProduct <> "" Then
                    bStocked.MoveLast
                    bStocked.Edit
                    bStocked!Variation = varProduct
                    bStocked.upDate
                Else
                    counter = counter - 1
                End If

            ElseIf counter = 4 Then
                PackSize = Nz(fld.value, "")

                If PackSize <> "" Then
                    bStocked.MoveLast
                    bStocked.Edit
                    bStocked!PackSize = PackSize
                    bStocked.upDate
                Else
                    counter = counter - 1
                End If

            ElseIf counter = 5 Then
                priceType = Nz(fld.value, "")

                If priceType <> "" Then
                    bStocked.MoveLast
                    bStocked.Edit
                    bStocked![RRP-PMP] = priceType
                    bStocked.upDate
                Else
                    counter = counter - 1
                End If

            ElseIf counter = 6 Then
                casesSold = Nz(fld.value, "")

                If casesSold <> "" Then
                    bStocked.MoveLast
                    bStocked.Edit
                    bStocked!CPW = casesSold
                    bStocked.upDate
                Else
                    counter = counter - 1
                End If
            End If
        End If

        counter = counter + 1

        If counter >= 7 Then
            counter = 2
            bStocked.AddNew
            bStocked!AccountNo = AutoID
            bStocked.upDate
        End If

    Next

    temp.MoveNext

    counter = 0

Loop

DoCmd.SetWarnings False
DoCmd.RunSQL "DELETE * FROM [tbl_BrandsStocked] WHERE [Brand] Is null"
DoCmd.SetWarnings True

Set dbs = Nothing
Set temp = Nothing
Set bStocked = Nothing
Set fld = Nothing

End Sub

Upvotes: 2

Related Questions