Full code posted below.
However I do not thnk this is a coding problem.
It worked fine in December, and works fine now, until I open and close the
macro for editing. Simply opening and closing making no changes causes the
problem to appear.
Option Compare Database
Option Explicit
Function FillEmploy()
Dim DB As Database, Qry As QueryDef, Qry_def As String
Dim EMP_No As Recordset, Emp_Earnings As Recordset, Er As Recordset, EMPFill
As Recordset
Dim NL As String, TrmQrt As String, RetVal As Variant
Dim i As Integer, j As Integer, k As Integer, n As Integer
Dim ErId As String, SD As String, ED As String, Fill As Boolean
Dim ib As Integer, ie As Integer, IFirst As Integer, IHoldB As Integer,
IHoldE As Integer
Dim IStart As Boolean, Init As Boolean
Dim ErNo(150), ErEst(150), ErEarn(150), EmpDate(150) As String
Dim HoldEmpNo As Variant, HoldEarn As Variant
Dim ErSum As Integer
Set DB = CurrentDb
RetVal = SysCmd(SYSCMD_SETSTATUS, "Running Gross Output Crosstab")
Set EMP_No = DB.OpenRecordset("ct01 UnFilled Employees", dbOpenDynaset)
RetVal = SysCmd(SYSCMD_SETSTATUS, "Running employees Crosstab")
Set Emp_Earnings = DB.OpenRecordset("ct03 UnFilled Earnings", dbOpenDynaset)
Set Er = DB.OpenRecordset("Employer_List", dbOpenTable)
Set EMPFill = DB.OpenRecordset("EmployerHistoryFill", dbOpenTable)
NL = Chr$(13) & Chr$(10)
TrmQrt = InputBox("Please enter terminal quarter of fiscal year" & NL & "For
example 2005_3")
EmptyTable ("EmployerHistoryFill")
n = EMP_No.Fields.Count - 1
ib = 10
ie = n
EMP_No.MoveFirst
For i = ib To ie
EmpDate(i) = EMP_No(i).Name
If EmpDate(i) = TrmQrt Then
ie = i
Exit For
End If
Next
RetVal = SysCmd(SYSCMD_SETSTATUS, "Generating Data")
k = 0
Do Until EMP_No.EOF
k = k + 1
ErId = EMP_No!EMP_IDCK
Fill = EMP_No(7)
SD = EMP_No(8)
ED = EMP_No(9)
For i = ib To ie
ErNo(i) = EMP_No(i)
ErEst(i) = 0
ErEarn(i) = Emp_Earnings(i)
Next
If Fill Then
Init = True
IFirst = 0
For i = ib To ie
If Not IsNull(ErNo(i)) Then
' Identify I for first real value
If IFirst = 0 Then
IFirst = i
End If
If IStart And Not Init Then
' Fill between values
HoldEmpNo = (HoldEmpNo + ErNo(i)) / 2
HoldEarn = (HoldEarn + ErEarn(i)) / 2
For j = IHoldB + 1 To IHoldE
ErNo(j) = HoldEmpNo
ErEarn(j) = HoldEarn
ErEst(j) = 1
Next
End If
IHoldB = i
HoldEmpNo = ErNo(i)
HoldEarn = ErEarn(i)
IStart = False
Init = False
Else
IHoldE = i
IStart = True
End If
Next
' Fill to End date or terminal quarter based on last real value
For j = IHoldB + 1 To n
If EmpDate(j) <= ED Then
ErNo(j) = HoldEmpNo
ErEarn(j) = HoldEarn
ErEst(j) = 2
End If
Next
' Fill from Start date based on first real value
For j = ib To (IFirst - 1)
If EmpDate(j) >= SD Then
ErNo(j) = ErNo(IFirst)
ErEarn(j) = ErEarn(IFirst)
ErEst(j) = 3
End If
Next
End If
' Fill a value of 0.001 if all quarters = null or 0
ErSum = 0
For i = ib To ie
If Not IsNull(ErNo(i)) Then
ErSum = ErSum + ErNo(i)
Exit For
End If
Next
If ErSum = 0 Then
For i = ib To ie
ErNo(i) = 0.001
ErEarn(i) = 0.001
ErEst(i) = 4
Next
End If
For i = ib To ie
If ErNo(i) > 0 And ErId <> "0000004" Then
' Exclude dummy id 0000000 used to force cross tablations to show
all quarters
EMPFill.AddNew
EMPFill!EMP_IDCK = ErId
EMPFill!State = 4
EMPFill!Yr_Qtr = EmpDate(i)
EMPFill!EMPLOYEES = ErNo(i)
EMPFill!NGROSS = ErEarn(i)
EMPFill!Fill = ErEst(i)
EMPFill.Update
End If
Next
' Fill a value of 0.001 if total data for employer=0
If IFirst = 0 Then
If i = ie Then
ErNo(ie) = 0.001
ErEarn(ie) = 0.001
ErEst(ie) = 4
End If
End If
EMP_No.MoveNext
Emp_Earnings.MoveNext
RetVal = SysCmd(SYSCMD_SETSTATUS, "Generating Record # " & Str(k))
Loop
Emp_Earnings.Close
EMP_No.Close
Er.Close
EMPFill.Close
' EmpNoFill.Close
' Ind.Close
RetVal = SysCmd(SYSCMD_CLEARSTATUS)
MsgBox "Data Filled"
End Function