VBA Open Recordset get value of a column that changes dynamically

[paul.holness]

Hello new to this forum:

When I 'Catch' the CatchCWO, CatchRWO, CatchCost, CatchRate as noted below I get:

CatchCWO: 60001548 (All the Work Orders associated to the above - PERFECT!)
CatchRWO: Exact match to the above - PERFECT!
CatchCost: Jan160001548 (A static date associated to the field name - What the Heck! It should be the value...)
CatchRate: Jan1 (... same)
Vxy = Round((CatchRate * CatchCost), 2): Type Mismatch - rrrrrr!

I have a headache! Why will it not CatchCost or CatchRate ? When I Manually enter the column name !Jan1 it updates Jan1 - cool. But because its dynamically populating the column/field name using 'Fieldn' I use "!" & Fieldn & " it craps out - why why why I need a fresh pair of eyes... Please and thanks!

Here is the code:

For Each SearchAcsFieldNameStartDate In db.TableDefs("" & OpMatchCostTbl & "").Fields
Debug.Print SearchAcsFieldNameStartDate.Name
Fieldn = SearchAcsFieldNameStartDate.Name
For lngPosition = LBound(strDaily) To UBound(strDaily)
If Fieldn = strDaily(lngPosition) Then
Dim rstOpMatchCostTbl As Recordset
Set rstOpMatchCostTbl = db.OpenRecordset("SELECT LOrder, " & Fieldn & " FROM " & OpMatchCostTbl & "", dbOpenDynaset)
With rstOpMatchCostTbl
Do While True
CatchCWO = !LOrder
CatchCost = !["Fieldn"]
'CatchCost = 500
Dim rstOpMatchRateTbl As Recordset

Set rstOpMatchRateTbl = db.OpenRecordset("SELECT Order, " & Fieldn & " FROM " & OpMatchRateTbl & "", dbOpenDynaset)
With rstOpMatchRateTbl
Do While True
CatchRWO = !Order
'CatchRate = Fieldn
CatchRate = 0.14

If CatchCWO = CatchRWO Then
If CatchRate <= "0" Then
Vxy = "0"
Else
'Update Result Table
Vxy = Round((CatchCost * CatchRate), 2)
db.Execute "UPDATE TestingAdeResults " _
& "SET " & Fieldn & " = '" & Vxy & "'" _
& "WHERE LOrder = '" & CatchRWO & "';"
End If


GoTo Err2:
Else
GoTo Err1:
End If
Err1:
.MoveNext
If .EOF Then Exit Do
Loop
.Close

End With
Err2:
.MoveNext
If .EOF Then Exit Do
Loop
End With
End If
Next lngPosition
Next

Any help is much appreciated thanks!

[pbaldy]

You're trying to use a dynamic field name (normalization issue?)? Try

CatchCost = .Fields(Fieldn)

[paul.holness]

It seems to be working!! Thanks much!! This has been an all day headache... Ill continue running test in install mode and keep you posted. Thanks again!!

[pbaldy]

No problemo!

[paul.holness]

Thanks for your support we got it fixed. See completed working code below: (still testing before I mark this issue as SOLVED!)

Private Sub RunFSReport_Click()
Dim PauseTime, Start
Dim db As DAO.Database
Dim SearchAcsFieldNameStartDate As DAO.Field
Dim AllocationEndDate As Date
Dim strDaily(0 To 365) As String, lngPosition As Long

strDaily(0) = "Jan1"
strDaily(1) = "Jan2"
strDaily(2) = "Jan3"
strDaily(3) = "Jan4"
strDaily(4) = "Jan5"
strDaily(5) = "Jan6"
strDaily(6) = "Jan7"
strDaily(7) = "Jan8"
strDaily(8) = "Jan9"
strDaily(9) = "Jan10"
strDaily(10) = "Jan11"
tbl_CombSpringInputFile = "CAJanJun"
VarFS = txtFS
'VarFS = "2013-CAT-AFE"
MkMatchCostTbl = "TestAdeRequestCost" 'change tblname after testing
MkMatchRateTbl = "TestAdeRequestRate" 'change tblname after testing
MkResultTbl = "MkTblTestAdeRequest" 'change tblname after testing
OpMatchCostTbl = "MatchCostTbl" 'change tblname after testing
OpMatchRateTbl = "MatchRateTbl" 'change tblname after testing
AllocationEndDate = "2013/6/30"
AllocationEndDateSerial = Int(CDbl(AllocationEndDate))
Set db = CurrentDb()
QuestionToMessageBox = "Are you sure you would like to continue with updating the Cost Analyst number 1 Input File?" & vbNewLine & "" & vbNewLine & "Click YES to continue with this update."
YesOrNoAnswerToMessageBox = MsgBox(QuestionToMessageBox, vbYesNo, "The PR# already exists:")
If YesOrNoAnswerToMessageBox = vbNo Then
Exit Sub
End If

DoCmd.OpenForm "frm_processing"
PauseTime = 1 ' Set duration in seconds
Start = Timer ' Set start time.
Do While Timer < Start + PauseTime
DoEvents ' Yield to other processes.
Loop
If VarFS <> "" Then
'Update CAJanJun FSColumn with VarFS
db.Execute "UPDATE " & tbl_CombSpringInputFile & " " _
& "SET FundingSource = '" & VarFS & "';"
CombSpringInputFileUpdated = 1
End If
If CombSpringInputFileUpdated = 1 Then
DoCmd.SetWarnings False
DoCmd.OpenQuery "" & MkMatchCostTbl & ""
DoCmd.Close acQuery, "" & MkMatchCostTbl & ""
DoCmd.OpenQuery "" & MkMatchRateTbl & ""
DoCmd.Close acQuery, "" & MkMatchRateTbl & ""
DoCmd.OpenQuery "" & MkResultTbl & ""
DoCmd.Close acQuery, "" & MkResultTbl & ""
DoCmd.SetWarnings True
End If
For Each SearchAcsFieldNameStartDate In db.TableDefs("" & OpMatchCostTbl & "").Fields
Debug.Print SearchAcsFieldNameStartDate.Name
Fieldn = SearchAcsFieldNameStartDate.Name
For lngPosition = LBound(strDaily) To UBound(strDaily)
If Fieldn = strDaily(lngPosition) Then
Dim rstOpMatchCostTbl As Recordset
Set rstOpMatchCostTbl = db.OpenRecordset("SELECT LOrder, " & Fieldn & " FROM " & OpMatchCostTbl & "", dbOpenDynaset)
With rstOpMatchCostTbl
Do While True
CatchCWO = !LOrder
CatchCost = .Fields(Fieldn)

Dim rstOpMatchRateTbl As Recordset

Set rstOpMatchRateTbl = db.OpenRecordset("SELECT Order, " & Fieldn & " FROM " & OpMatchRateTbl & "", dbOpenDynaset)
With rstOpMatchRateTbl
Do While True
CatchRWO = !Order
CatchRate = .Fields(Fieldn)

If CatchCWO = CatchRWO Then
If CatchRate <= "0" Then
Vxy = "0"
Else
'Update Result Table
Vxy = Round((CatchCost * CatchRate), 2)
db.Execute "UPDATE TestingAdeResults " _
& "SET " & Fieldn & " = '" & Vxy & "'" _
& "WHERE LOrder = '" & CatchRWO & "';"
End If
GoTo Err2:
Else
GoTo Err1:
End If
Err1:
.MoveNext
If .EOF Then Exit Do
Loop
.Close

End With
Err2:
.MoveNext
If .EOF Then Exit Do
Loop
End With
End If
Next lngPosition
Next
DoCmd.Close acForm, "frm_processing"
DoCmd.OpenForm "frm_Update"
PauseTime = 1 ' Set duration in seconds
Start = Timer ' Set start time.
Do While Timer < Start + PauseTime
DoEvents ' Yield to other processes.
Loop
DoCmd.Close acForm, "frm_Update"
DoCmd.OpenTable "TestingAdeResults"
Application.RefreshDatabaseWindow
End Sub