Array or Temp Recordset comparison within nested loop


DevX Home    Today's Headlines   Articles Archive   Tip Bank   Forums   

Results 1 to 4 of 4

Thread: Array or Temp Recordset comparison within nested loop

  1. #1
    Join Date
    May 2008
    Posts
    31

    Array or Temp Recordset comparison within nested loop

    The code which follows works well I just need to add one component to make it complete.

    I need the inner loop to write origin's (country codes) to an array or temporary recordset depending on the document type MA or CO

    At the end of the loop (related records) I need to see if there are any records in MA array or recordset that are not in the CO array or record set.

    For example

    CO array or recordset MA array or recordset

    CA CA
    US US
    MX


    These arrays are typically going to be quite small because they will only be composed of the following values CA, MX, US

    in the example above the MX in MA but not in the CO will make the vendor item NOP or Non Originating Pending

    This could be tongue in cheek called more fun with NAFTA rules

    Anyhow any help would be appreciated.

    Code:
    Function Originating()
    Dim dbs As Database
    Dim rstable As DAO.Recordset
    Dim rstable2 As DAO.Recordset
    Dim nafta As Boolean
    Dim none As Boolean
    Dim foreign As Boolean
    Dim code As String
    Dim year As Integer
    Dim item As String
    Dim VENDOR_KEY As String
    Dim Origin  As String
    Set dbs = CurrentDb
    Set rstable = dbs.OpenRecordset("tbl_originating_data_set", dbOpenTable)
    Set rstable2 = dbs.OpenRecordset("tbl_originating_results", dbOpenTable)
    
    Do While Not rstable.EOF
    'Used to exit function at new record (EOF apparently not working)
        If IsNull(rstable!doc_yr) Then
            Exit Function
    End If
    'These three items determine related records in recordset. when any of these change it is a new eval set.
    year = rstable!doc_yr
    item = rstable![Oracle number]
    VENDOR_KEY = rstable!VENDOR_KEY
    
    Do Until year <> rstable!doc_yr Or item <> rstable![Oracle number] Or VENDOR_KEY <> rstable!VENDOR_KEY
    
        If nafta = False And rstable!nafta = True Then
            nafta = True
                End If
        If none = False And rstable!none = True Then
            none = True
                End If
        If foreign = False And rstable!foreign = True Then
            foreign = True
                End If
        rstable.MoveNext
    Loop
    
    With rstable2
        
    'Determine Originating, Non Originating, Non Originating Pending
    
        If nafta = True And foreign = False And none = False Then
            code = "O"
                End If
    
        If foreign = True And none = False Then
            code = "NO"
                End If
    
        If none = True Or (nafta = False And foreign = False And none = False) Then
            code = "NOP"
                End If
    .AddNew
        !doc_yr = year
        ![Oracle number] = item
        !VENDOR_KEY = VENDOR_KEY
        !code = code
    .Update
    End With
    
    code = ""
    year = 0
    item = ""
    VENDOR_KEY = ""
    nafta = False
    none = False
    foreign = False
    Loop
    End Function

    Thanks.

    Mike Pigott

  2. #2
    Join Date
    May 2008
    Posts
    31
    This works

    Code:
    Function Originating()
    Dim dbs As Database
    Dim rstable As DAO.Recordset
    Dim rstable2 As DAO.Recordset
    Dim nafta As Boolean
    Dim none As Boolean
    Dim foreign As Boolean
    Dim code As String
    Dim year As Integer
    Dim item As String
    Dim VENDOR_KEY As String
    
    Dim arCO() As String
    Dim arMA() As String
    Dim numMA As Integer
    Dim numCO As Integer
    Dim i As Integer, j As Integer
    Dim MACOMatch As Boolean, bIsEmpty As Boolean
    
    Set dbs = CurrentDb
    Set rstable = dbs.OpenRecordset("tbl_originating_data_set", dbOpenTable)
    Set rstable2 = dbs.OpenRecordset("tbl_originating_results", dbOpenTable)
    
    numMA = 0
    numCO = 0
    
    Do While Not rstable.EOF
        If IsNull(rstable!doc_yr) Then
            Exit Function
        End If
    
        year = rstable!doc_yr
        item = rstable![Oracle number]
        VENDOR_KEY = rstable!VENDOR_KEY
        
        Do Until year <> rstable!doc_yr Or item <> rstable![Oracle number] Or VENDOR_KEY <> rstable!VENDOR_KEY
    
            If nafta = False And rstable!nafta = True Then
                nafta = True
            End If
            If none = False And rstable!none = True Then
                none = True
            End If
            If foreign = False And rstable!foreign = True Then
                foreign = True
            End If
            
            If rstable!doc_type = "MA" And (rstable!origin = "MX" Or rstable!origin = "CA" Or rstable!origin = "US") Then
                numMA = numMA + 1
                ReDim Preserve arMA(numMA)
                arMA(numMA) = rstable!origin
            End If
            
            If rstable!doc_type = "CO" And (rstable!origin = "MX" Or rstable!origin = "CA" Or rstable!origin = "US") Then
                numCO = numCO + 1
                ReDim Preserve arCO(numCO)
                arCO(numCO) = rstable!origin
            End If
            
            rstable.MoveNext
        Loop
    
        With rstable2
            .AddNew
            !doc_yr = year
            ![Oracle number] = item
            !VENDOR_KEY = VENDOR_KEY
        
            If nafta = True And foreign = False And none = False Then
                code = "O"
            End If
    
            If foreign = True And none = False Then
                code = "NO"
            End If
    
            If none = True Or (nafta = False And foreign = False And none = False) Then
                code = "NOP"
            End If
    
            If Not code = "NO" Then
                bIsEmpty = CBool(LenB(Replace(Join(arMA, vbCr), vbCr, vbNullString)) = 0)
                If Not CBool(LenB(Replace(Join(arMA, vbCr), vbCr, vbNullString)) = 0) _
                And Not CBool(LenB(Replace(Join(arCO, vbCr), vbCr, vbNullString)) = 0) Then
                    For i = LBound(arMA) To UBound(arMA)
                        code = "NOP"
                        For j = LBound(arCO) To UBound(arCO)
                            If arMA(i) = arCO(j) Then
                                MACOMatch = True
                            End If
                        Next j
                        If Not MACOMatch Then
                            Exit For
                        End If
                        MACOMatch = False
                        code = "O"
                    Next i
                End If
            End If
                
                    
            !code = code
            .Update
        End With
    
        code = ""
        year = 0
        item = ""
        VENDOR_KEY = ""
        nafta = False
        none = False
        foreign = False
        ReDim arMA(0)
        ReDim arCO(0)
        numMA = 0
        numCO = 0
    Loop
    
    Set dbs = Nothing
    Set rstable = Nothing
    Set rstable1 = Nothing
    End Function

  3. #3
    Join Date
    Apr 2007
    Location
    Sterling Heights, Michigan
    Posts
    8,666
    Does this mean your issue is resolved or do you still have questions?
    I don't answer coding questions via PM or Email. Please post a thread in the appropriate forum section.
    Please use [Code]your code goes in here[/Code] tags when posting code.
    Before posting your question, did you look here?
    Got a question on Linux? Visit our Linux sister site.
    Modifications Required For VB6 Apps To Work On Vista

  4. #4
    Join Date
    May 2008
    Posts
    31
    Hack,

    It is resolved. Thanks.

Similar Threads

  1. Replies: 2
    Last Post: 12-12-2005, 10:03 AM
  2. Array to ADODB recordset
    By danielreber in forum VB Classic
    Replies: 8
    Last Post: 10-12-2005, 01:44 PM
  3. Comparison methods
    By ericelysia1 in forum Java
    Replies: 34
    Last Post: 05-15-2005, 07:39 PM
  4. GOSUB vs. Macros vs. Nested Functions
    By Jonathan Allen in forum .NET
    Replies: 331
    Last Post: 03-19-2001, 09:00 AM
  5. Replies: 0
    Last Post: 02-25-2001, 09:33 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
HTML5 Development Center
 
 
FAQ
Latest Articles
Java
.NET
XML
Database
Enterprise
Questions? Contact us.
C++
Web Development
Wireless
Latest Tips
Open Source


   Development Centers

   -- Android Development Center
   -- Cloud Development Project Center
   -- HTML5 Development Center
   -- Windows Mobile Development Center