Option Compare Database
Option Explicit
Private Sub cmdAdjustCodes_Click()
Dim lngRetval As Integer
lngRetval = fnReplaceNullCodes("tblZipsCoded")
MsgBox lngRetval & " rows adjusted.", vbOKOnly, "Informational."
End Sub
Private Function fnReplaceNullCodes(strTableName As String) As Long
' variables to hold most recent coded values
Dim lngIdentity As Long
Dim strZip As String
Dim strRegCode As String
Dim strRegion As String
Dim recset As DAO.Recordset
Dim lngRetval As Long
Dim strQuery As String
Dim lngIndex As Long
' strQuery = "SELECT * FROM " & strTableName & " ORDER BY Zip"
strQuery = "SELECT * FROM " & strTableName
strQuery = strQuery & " ORDER BY Zip, RegCode DESC"
Set recset = DBEngine(0)(0).OpenRecordset(strQuery)
If recset.RecordCount = 0 Then
MsgBox "No data found.", vbOKOnly, "Missing data."
fnReplaceNullCodes = 0
Exit Function
End If
' assumption is that rirst row is NOT NULL
recset.MoveLast
recset.MoveFirst
For lngIndex = 1 To recset.RecordCount
If lngIndex = 1 Then
lngIdentity = recset.Fields("Identity")
strZip = recset.Fields("Zip")
strRegCode = recset.Fields("RegCode")
strRegion = recset.Fields("Region")
Else
If IsNull(recset.Fields("RegCode")) Then
' set update sql
strQuery = "UPDATE " & strTableName & " SET "
strQuery = strQuery & "Zip = '" & strZip & "',"
strQuery = strQuery & "RegCode = '" & strRegCode & "',"
strQuery = strQuery & "Region = '" & strRegion & "'"
strQuery = strQuery & " WHERE Identity = " & recset.Fields("Identity")
DoCmd.SetWarnings False
DoCmd.RunSQL strQuery
DoCmd.SetWarnings True
lngRetval = lngRetval + 1
Else
lngIdentity = recset.Fields("Identity")
strZip = recset.Fields("Zip")
strRegCode = recset.Fields("RegCode")
strRegion = recset.Fields("Region")
End If
End If
recset.MoveNext
Next lngIndex
fnReplaceNullCodes = lngRetval
End Function
This will replace any null with the most recent preceding non null values,
regardless of the value of the Zip.
If you wish I can send the .mdb
Jack