Option Compare Database
By Elliot Jaspin 

This script is designed for use in Microsoft Access. To use, cut and paste it 
into a new 
module, then adjust database and field names to reflect your data. For more 
information 
about this program, see the related article in Uplink, March-April 2007.

Option Explicit
Dim records(1 To 20, 1 To 6) As Variant
    Const state As Integer = 1
    Const county As Integer = 2
    Const year As Integer = 3
    Const total As Integer = 4
    Const black As Integer = 5

Sub main()

    Dim db As Database
    Dim rec As Recordset
    Dim oldstate As String, oldcounty As String, oldyear As Integer
    Dim newstate As String, newcounty As String, newyear As Integer
    Dim i As Integer
    
    
    ' open up the apartheid database
     Set db = CurrentDb

    ' Select all the fields and order table by state, county and year
     Set rec = db.OpenRecordset("SELECT State, county, year, total, black " _
        & "FROM Cntycen " _
        & "ORDER BY State, county, year;")
    
    ' seed the old variables
    With rec
      .MoveFirst
       oldstate = rec!state
       oldcounty = rec!county
       i = 1
         ' records(i, state) = rec!state
         ' records(i, county) = rec!county
         ' records(i, year) = rec!year
         ' records(i, total) = rec!total
         ' records(i, black) = rec!black
    End With
    
    
    'Loop through the records
    Do
   

     
       'if we are dealing with the same county and state we copy the record to 
the array
       If (rec!state = oldstate) And (rec!county = oldcounty) Then
          i = i + 1
          records(i, state) = rec!state
          records(i, county) = rec!county
          records(i, year) = rec!year
          records(i, total) = rec!total
          records(i, black) = rec!black
        Else
          oldstate = rec!state
          oldcounty = rec!county
          'we analyze the array here
          If isdrop(i) Then
            saverecs (i)
          End If
          i = 1
          records(i, state) = rec!state
          records(i, county) = rec!county
          records(i, year) = rec!year
          records(i, total) = rec!total
          records(i, black) = rec!black
        End If
        
           rec.MoveNext
    Loop Until rec.EOF
    
    'analyze the last group of records
          If isdrop(i) Then
            saverecs (i)
          End If

    ' Call EnumFields to print recordset contents.
    'EnumFields rst, 12
    db.Close

End Sub



Function isdrop(elements As Integer) As Boolean

  Dim i As Integer
  isdrop = False
     
  For i = 2 To (elements - 1)
  
   If records(i, black) = 0 Then
          records(i, black) = 1
   End If
   If records(i + 1, black) = 0 Then
          records(i + 1, black) = 1
  
    End If
    If ((records(i, black) - records(i + 1, black)) / records(i, black) >= 0.49) 
Then
      isdrop = True
      Exit Function
    End If
     
  Next i
End Function



Sub saverecs(elements As Integer)

 Dim i As Integer
 Dim db As Database
 Dim keep As Recordset
  
  Set db = CurrentDb()
  Set keep = db.OpenRecordset("suspect")
  
  For i = 1 To elements
    With keep
      .AddNew
         !state = records(i, state)
         !county = records(i, county)
         !year = records(i, year)
         !total = records(i, total)
         !black = records(i, black)
       .Update
    End With
   Next i

  
End Sub