Creating an array for month/year fields 2

[josephwc]

Hello,

I have never created an array before but I know enough to know that I probably need to create one now. Unfortunately the problem I have does not seem like a beginner array problem. Access XP

I have fields on a form called
txtpast01, txtjan200601, ...txtdec200701, txtfuture01
to
txtpast08, txtjan200608, ...txtdec200708, txtfuture08

The number at the end of the field name associate the date fields to fields called txtfunc01 through txtfunc08.

If txtfunc01 is null then no month/year fields for the 01 row need to be filled out and so on.

I want to create a button when clicked automatically enters values into the month/year fields for the rows that have the txtfunc filled out.

There is a field called "Estimated Start Date" which determines what month/year field the values should start on.

There is a field called "duration" which says how many month/year fields past the estimated start date data should be entered.

There is also a reference table called "tbldur" which contains fields called "duration", "m", "m1" ... "m25". The duration can be linked to the duration referenced in the form and the "m" fields contain values which can fill the month/year fields in.

What should happen on click would be if Estimated Start Date is "10/1/2007" and duration is 6 and only txtfunc01 is filled in then txtoct200701 = m1, txtnov200701 = m2, txtdec200701 = m3, txtfuture01 = m4 + m5 + m6.

Please help. I have no idea how to do this.

 

[josephwc]

InternalProject ID value is a sequential number assigned to each project and the Function Code field is a text value. internalFunctionID is a autonumber in the ProjectFunction table.

Here is how the table looks
internalFunctionID InternalProjectID FunctionCode
1 1 BEAM
2 1 Performance Mgmt
3 1 CRS
4 1 Customer Service
5 2 ACQ
6 3 Acquirer Solutions
7 4 Development

On the form frmEditProposal there are eight individual fields in only one Project record. Below is how the data for InternalProjectID 1 looks like

txtFunc01 = BEAM
txtFunc02 = Performance Mgmt
txtFunc03 = CRS
txtFunc04 = Customer Service
txtFunc05 =
txtFunc06 =
txtFunc07 =
txtFunc08 =

 

[MajP]

I would prefer to look this up in a table in case you add functions or change their name. But based on the info I Had:

Public Function functionNameToNumber(strFuncCode As String) As Integer
  Select Case strFuncCode
    Case "BEAM"
       functionNameToNumber = 1
    Case "Performance Mgmt"
       functionNameToNumber = 2
    Case "CRS"
       functionNameToNumber = 3
    Case "Customer Service"
       functionNameToNumber = 4
    Case "ACQ"
       functionNameToNumber = 5
    Case "Acquirer Solutions"
       functionNameToNumber = 6
    Case "Development"
      functionNameToNumber = 7
    Case "Forgot One"
      functionNameToNumber = 8
 End Select
End Function

So the call is

  strFuncCode = rsFunction.Fields("FunctionCode")
  strFuncValue = functionNameToNumber(strFuncCode)

 

[josephwc]

I do have a table with the values in it used for all different drop downs. The relevant records have a statisdatatype of "functionName". I will need to base the values off the table since the function names change from time to time.

staticDataType code
functionName PA Customized Reports
functionName Spending Pulse
functionName Commerce Intel
functionName Data Warehousing
functionName IPS Training and Support
functionName LTS Location Services
functionName PA Alerts
functionName PA Marketing Enhanced
functionName PA Compass
functionName Crosssell Internet
functionName PA ECCP
functionName PA ECCP Enhanced
functionName PA Fraud Advisor
functionName PA Interchange with Benchmarking
functionName PA Marketing Basic
functionName PA Marketing Benchmark Reports
functionName PA Campaign Management Only
functionName Acquirer Solutions
functionName Decision Sciences
functionName Credit Risk Mgmt
functionName Business Analytics
functionName Other
functionName Mktg Services
functionName Ops CallCtrs
functionName ACQ
functionName Strat Del Mgmt
functionName Channel Support
functionName PA Total Customer View
functionName PA Targeted Packages Fraud
functionName PA Targeted Packages Chargebacks
functionName PA RPPS
functionName DirectSales
functionName PA Targeted Packages Authorizations
functionName LTS Targeting Solutions
functionName PA Other
functionName BPI
functionName PA Operations Basic
functionName PA Paypass
functionName PA PIN Performance
functionName PA Pre Paid
functionName Business Optimztn Solutns
functionName PA Menu Based Pricing
functionName BusiPerformance Mgmt
functionName LTS ATM Data Leasing
functionName PA Mining
functionName Rewards and Loyalty
functionName Product Development
functionName Marketplace Research
functionName Benchmarking
functionName Customer Marketing
functionName Customer Pref and Exp
functionName MarketScope
functionName Retail Payment Solutions
functionName BEAM
functionName MLCS Operations Delivery
functionName Processing
functionName Affluent
functionName Commercial
functionName xDCS
functionName PA Operations Enhanced
functionName Debit
functionName Tower Group
functionName WCS EMS
functionName WCS ENH
functionName CRM Optimization
functionName WCS Fee Srvcs

 

[MajP]

So the txtFunc exist only in controls on the form and not in a Table? Is that right?

txtFunc01 = BEAM
txtFunc02 = Performance Mgmt
txtFunc03 = CRS
txtFunc04 = Customer Service
txtFunc05 =
txtFunc06 =
txtFunc07 =
txtFunc08 =

 

[josephwc]

yes

 

[MajP]

If so. Maybe these changes to read through the txtFunc text boxes

  'add
  Dim intFuncCounter As Integer
  Dim myRow As Integer
  'delete
  'strSqlFunc = "Select * from tblFunc where internalProjectID = '" & strProjectCode & "'"
  'Set rsFunction = CurrentDb.OpenRecordset(strSqlFunc, dbOpenDynaset)
 'Loop through all functions associated with a project
 'defined in the text boxes on the form

 'replace
 For intFuncCounter = 1 To 8
    If Not IsNull(Forms("frmEditProposalProject").Controls("txtFunc0" & intFuncCounter)) Then
      strFuncCode = Forms("frmEditProposalProject").Controls("txtFunc0" & intFuncCounter).Name
      myRow = CInt(Right(strFuncCode, 1))
      rsMValues.MoveFirst
      'loop through the relevant M value fields
      For intMCounter = 0 To intDuration - 1
        'if you get to the last contrl "txtDec2007xx" put everything in future
        If intMCounter + instStartMonth = 25 Then
          aCntrls(myRow, 25) = aCntrls(myRow, 25) + rsMvalue.Fields("m" & intMCounter + 1)
        Else
          aCntrls(myRow, intMCounter + intStartMonth) = rsMvalue.Fields("m" & intMCounter + 1)
        End If
     Next intMCounter
    End If
  Next intFuncCounter

 

[josephwc]

Getting an error saying "Object Variable or With Block Variable not set". The "Else" "aCntrls" line is highlighted.

Option Compare Database
Option Explicit
Dim aCntrls(1 To 8, 0 To 25) As Object


Public Sub insertMValues()
Dim rsMValues As DAO.Recordset
Dim rsFunction As DAO.Recordset
Dim dtmEstStartDate As Date
Dim intDuration As Integer
Dim intStartMonth As Integer
Dim intStartYear As Integer
Dim strSqlMValues As String
Dim strSqlFunc As String
Dim strProjectCode As String
Dim strFuncCode As String
Dim strFuncValue As String
Dim intMCounter As Integer
Dim intFuncCounter As Integer
Dim myRow As Integer


intDuration = Forms("frmEditProposalProject").txtProjectDuration
strProjectCode = Forms("frmEditProposalProject").txtProjectCode
dtmEstStartDate = Forms("frmEditProposalProject").txtEstProjStartDate
intStartMonth = Month(dtmEstStartDate)
intStartYear = Year(dtmEstStartDate)
strSqlMValues = "Select * from tblDur Where duration = " & intDuration
Set rsMValues = CurrentDb.OpenRecordset(strSqlMValues, dbOpenDynaset)
For intFuncCounter = 1 To 8
If Not IsNull(Forms("frmEditProposalProject").Controls("txtFuncCode0" & intFuncCounter)) Then
strFuncCode = Forms("frmEditProposalProject").Controls("txtFuncCode0" & intFuncCounter).name
myRow = CInt(Right(strFuncCode, 1))
rsMValues.MoveFirst
'loop through the relevant M value fields
For intMCounter = 0 To intDuration - 1
'if you get to the last contrl "txtDec2007xx" put everything in future
If intMCounter + intStartMonth = 25 Then
aCntrls(myRow, 25) = aCntrls(myRow, 25) + rsMValues.Fields("m" & intMCounter + 1)
Else
aCntrls(myRow, intMCounter + intStartMonth) = rsMValues.Fields("m" & intMCounter + 1)
End If
Next intMCounter
End If
Next intFuncCounter


End Sub

 

[MajP]

aCntrls" is an array of objects (access controls). It is a 8x26 dimensioned array so there are 208 references. The procedure "dateControlArray()" fills up this array with the controls from your form. It should "set" a control in all of these 208 reference locations. A couple things could happen.
1. The array could go out of scope if you throw an error before the "insertMValues" procedures run. Or if you do not run the "dateControlArray" prior to "insertMValues".
2. There could be an empty reference. For example if one of your controls is misnamed: "txtjam200601". This control was supposed to be set in the "aCntrls(1,1)" location, but it does not get set since it says "jam" not "jan".
3. So before running the "insertMValues" procedure run this to see if the array is fully populated:

Public Sub testIfSet()
  Dim intRow As Integer
  Dim intCol As Integer
  Dim strTemp As String
  Dim strNotSet As String
  On Error GoTo errLbl
  strNotSet = "The Following controls are not set:" & Chr(13)
  For intRow = 1 To 8
    For intCol = 0 To 25
       strTemp = aCntrls(intRow, intCol).Name
    Next intCol
  Next intRow
  MsgBox strNotSet, vbInformation
Exit Sub
errLbl:
  If Err.Number = 91 Then
    strNotSet = strNotSet & "(" & intRow & "," & intCol & ")" & Chr(13)
  End If
  Err.Clear
  Resume Next
End Sub

This will list all the locations that are not set. If you have even one value appear in the msgbox, the whole thing will not work.I will not be around until Friday night but keep posting. I understand a lot better what you are doing, so I will try to think of a cleaner way of doing this.

 

[josephwc]

The message came up and showed all locations not being set. It listed all of them sequentially...(0,1), (0,2) etc.

 

[MajP]

Try running the code like this. You need to fill the array and then check if they are all set.

private sub cmdFillForm_click()
call dateControlArray()
call testIfSet()
'call insertMValues()
end sub

However, now that I understand what you are doing I think I can give some simpler code. The original code was short, but had a lot of moving pieces, and chances to error out.

 

[MajP]

This is actually much simpler. Instead of setting up an array it just uses the naming convention to determine the next text box to fill in. This is all you need

Public Sub insertMValues()
  Dim rsMValues As DAO.Recordset
  Dim dtmEstStartDate As Date
  Dim intDuration As Integer
  Dim intStartMonth As Integer
  Dim intStartYear As Integer
  Dim strSqlMValues As String
  Dim strFuncCode As String
  Dim intMCounter As Integer
  Dim frmPropProj As Access.Form
  Dim intFuncCounter As Integer
  Dim intCurrentMonth As Integer
  Dim intCurrentYear As Integer
  Dim strCurrentTextBox As String
  Set frmPropProj = Forms("frmEditProposalProject")
  
  intDuration = frmPropProj.txtProjectDuration
  dtmEstStartDate = frmPropProj.txtEstProjStartDate
  intStartMonth = Month(dtmEstStartDate)
  intCurrentMonth = intStartMonth
  intStartYear = Year(dtmEstStartDate)
  intCurrentYear = intStartYear
  
  strSqlMValues = "Select * from tblDur Where duration = " & intDuration
  Set rsMValues = CurrentDb.OpenRecordset(strSqlMValues, dbOpenDynaset)
  
 'Loop through all functions associated with a project
 'defined in the text boxes on the form
 For intFuncCounter = 1 To 8
    If Not IsNull(frmPropProj.Controls("txtFunc0" & intFuncCounter)) Then
      strFuncCode = "0" & intFuncCounter
      rsMValues.MoveFirst
      'loop through the relevant M value fields
     strCurrentTextBox = "txt" & fncStrMonth(dtmEstStartDate) & Str(intCurrentYear) & strFuncCode
     For intMCounter = 0 To intDuration - 1
        'if you get to the last contrl "txtDec2007xx" put everything in future
        If intCurrentYear = 2007 And intCurrentMonth = 12 Then
          frmPropProj.Controls(strCurrentTextBox) = "txtdec20070" & intFuncCounter
          frmPropProj.Controls(strCurrentTextBox) = frmPropProj.Controls(strCurrentTextBox) + rsMValues.Fields("m" & intMCounter + 1)
        Else
          frmPropProj.Controls(strCurrentTextBox) = rsMValues.Fields("m" & intMCounter + 1)
        End If
        
        'increment the year and month and find the next text box to fill.
        If intCurrentYear = 2006 And intCurrentMonth = 12 Then
          intCurrentYear = 2007
          intCurrentMonth = 1
        ElseIf intCurrentYear = 2007 And intCurrentMonth = 12 Then
          'do nothing
        Else
          intCurrentMonth = intCurrentMonth + 1
        End If
        strCurrentTextBox = "txt" & fncStrMonth(intCurrentMonth) & Str(intCurrentYear) & strFuncCode
     Next intMCounter
    End If
  Next intFuncCounter
End Sub
Public Function fncStrMonth(dtmDate As Date) As String
  fncStrMonth = Month(dtmDate)
  fncStrMonth = Format(fncStrMonth, "mmm")
  fncStrMonth = Format(fncStrMonth, "<")
End Function

Again, it is hard to verify without building your forms and tables. So I would expect some errors, but this way will be easier to debug.

 

[MajP]

Disregard what I sent you last. That was really screwed up. This should be closer

Public Sub insertMValues()
  Dim rsMValues As DAO.Recordset
  Dim dtmEstStartDate As Date
  Dim intDuration As Integer
  Dim strSqlMValues As String
  Dim strFuncCode As String
  Dim intMCounter As Integer
  Dim frmPropProj As Access.Form
  Dim intFuncCounter As Integer
  Dim intCurrentMonth As Integer
  Dim intCurrentYear As Integer
  Dim strCurrentTextBox As String
  
  Set frmPropProj = Forms("frmEditProposalProject")
  intDuration = frmPropProj.txtProjectDuration
  dtmEstStartDate = frmPropProj.txtEstProjStartDate
  intCurrentMonth = Month(dtmEstStartDate)
  intCurrentYear = Year(dtmEstStartDate)
  strSqlMValues = "Select * from tblDur Where duration = " & intDuration
  Set rsMValues = CurrentDb.OpenRecordset(strSqlMValues, dbOpenDynaset)
  
 'Loop through all functions associated with a project
 'defined in the text boxes on the form
 For intFuncCounter = 1 To 8
    If Not IsNull(frmPropProj.Controls("txtFunc0" & intFuncCounter)) Then
      strFuncCode = "0" & intFuncCounter
      rsMValues.MoveFirst
      'loop through the relevant M value fields
     strCurrentTextBox = "txt" & fncStrMonth(intCurrentMonth) & Str(intCurrentYear) & strFuncCode
     For intMCounter = 1 To intDuration
        ' if you moved into the txtFuturexx control then continue to
        ' put everything in future
        If Left(strCurrentTextBox, 9) = "txtFuture" Then
          frmPropProj.Controls(strCurrentTextBox) = frmPropProj.Controls(strCurrentTextBox) + rsMValues.Fields("m" & intMCounter)
        Else
          frmPropProj.Controls(strCurrentTextBox) = rsMValues.Fields("m" & intMCounter)
        End If
        'increment the year and month and find the next text box to fill.
        'if the year is 2006 and the month is 12 then the next box to fill has a name
        ' txtjan2007xx
        If intCurrentYear = 2006 And intCurrentMonth = 12 Then
          intCurrentYear = 2007
          intCurrentMonth = 1
          strCurrentTextBox = "txtjan2007" & strFuncCode
         'if the year is 2007 and the month is 12 then the next box to fill
         'has a name txtFuturexx
        ElseIf intCurrentYear = 2007 And intCurrentMonth = 12 Then
          strCurrentTextBox = "txtFuture" & strFuncCode
        'if the year is 2006 or 2007 and the month is not 12 then
        ' the new month equals the old month plus 1 and the the next
        ' box to fill has a name txt(oldmonth+1)YearFuncCode
        Else
          intCurrentMonth = intCurrentMonth + 1
          strCurrentTextBox = "txt" & fncStrMonth(intCurrentMonth) & Str(intCurrentYear) & strFuncCode
       End If
     Next intMCounter
    End If
  Next intFuncCounter
End Sub
Public Function fncStrMonth(intMonth As Integer) As String
  Select Case intMonth
     Case 1
      fncStrMonth = "jan"
    Case 2
      fncStrMonth = "feb"
    Case 3
      fncStrMonth = "mar"
    Case 4
      fncStrMonth = "apr"
    Case 5
      fncStrMonth = "may"
    Case 6
      fncStrMonth = "jun"
    Case 7
      fncStrMonth = "jul"
    Case 8
      fncStrMonth = "aug"
    Case 9
      fncStrMonth = "sep"
    Case 10
      fncStrMonth = "oct"
    Case 11
      fncStrMonth = "nov"
    Case 12
      fncStrMonth = "dec"
End Function

And then all you need is

private sub cmdFillForm_click()
  call insertMValues()
end sub

 

[MajP]

one more thing. Forgot an "end select" on the function:

  Case 12
     fncStrMonth = "dec"
 [b]end select [/b]
End Function

 

[josephwc]

This new code that you worked up worked a lot better. I think it is almost there.

Two problems left.

In a record with multiple txtfunc fields filled out the forecast values are not correct for anything past the first txtfunc. I selected a project with a 12 month duration with a txtestprojstartdate of April 2006. The "01" row was correct with values going out to March 2007. The "02" row however started plugging in values at March 2007 and spreading the values to the next 12 months. The values did not however go into txtfuture which is problem number 2.

In another case I selected a record with one txtfunc value but a duration of 36 months. The error that came up was "Item Not in Collection" highlighting the code frmPropProj.Controls(strCurrentTextBox) = frmPropProj.Controls(strCurrentTextBox) + rsMValues.Fields("m" & intMCounter)
which is below the If statement for txtfuture
Maybe the error has something to do with the "strCurrentTextBox" which only makes reference to fields with a "fncstrmonth" within its name.

How do I repair the code for these two issues?

 

[MajP]

1. First problem is easy. After filling in the M values, I need to reset the current year and month back to the start year and month, before going to the next function. As you saw, instead it started where it left off.
2. The second problem is slightly more complicated. The if check was set up so that when you got to dec 2007 it would put the next one in the future. What I did not do was check when you where in txtFuture to stay in txtFuture.
Try this

        If intCurrentYear = 2006 And intCurrentMonth = 12 Then
          intCurrentYear = 2007
          intCurrentMonth = 1
          strCurrentTextBox = "txtjan2007" & strFuncCode
         'if the year is 2007 and the month is 12 then the next box to fill
         'has a name txtFuturexx. If you are already int txtFutureXX stay there
        ElseIf (intCurrentYear = 2007 And intCurrentMonth = 12) [b]Or (Left(strCurrentTextBox, 9) = "txtFuture")[/b] Then
          strCurrentTextBox = "txtFuture" & strFuncCode
        'if the year is 2006 or 2007 and the month is not 12 then
        ' the new month equals the old month plus 1 and the the next
        ' box to fill has a name txt(oldmonth+1)YearFuncCode
        Else
          intCurrentMonth = intCurrentMonth + 1
          strCurrentTextBox = "txt" & fncStrMonth(intCurrentMonth) & Str(intCurrentYear) & strFuncCode
       End If
     Next intMCounter
    'reset to the start month and year
    [b]intCurrentMonth = Month(dtmEstStartDate)
    intCurrentYear = Year(dtmEstStartDate)[/b]
    End If
  Next intFuncCounter
End Sub

 

[josephwc]

Thank you so much for all your help. Everything is working now. Attached is the final result.

Public Sub insertMValues()
Dim rsMValues As DAO.Recordset
Dim dtmEstStartDate As Date
Dim intDuration As Integer
Dim strSqlMValues As String
Dim strFuncCode As String
Dim intMCounter As Integer
Dim frmPropProj As Access.Form
Dim intFuncCounter As Integer
Dim intCurrentMonth As Integer
Dim intCurrentYear As Integer
Dim strCurrentTextBox As String

Set frmPropProj = Forms("frmEditProposalProject")
intDuration = frmPropProj.txtProjectDuration
dtmEstStartDate = frmPropProj.txtEstProjStartDate
intCurrentMonth = Month(dtmEstStartDate)
intCurrentYear = Year(dtmEstStartDate)
strSqlMValues = "Select * from tblDur Where duration = " & intDuration
Set rsMValues = CurrentDb.OpenRecordset(strSqlMValues, dbOpenDynaset)

'Loop through all functions associated with a project
'defined in the text boxes on the form
For intFuncCounter = 1 To 8
If Not IsNull(frmPropProj.Controls("txtFuncCode0" & intFuncCounter)) Then
strFuncCode = "0" & intFuncCounter
rsMValues.MoveFirst
'loop through the relevant M value fields
strCurrentTextBox = "txt" & fncStrMonth(intCurrentMonth) & intCurrentYear & strFuncCode
For intMCounter = 1 To intDuration
' if you moved into the txtFuturexx control then continue to
' put everything in future
If intMCounter < 26 Then
If Left(strCurrentTextBox, 9) = "txtfuture" Then
frmPropProj.Controls(strCurrentTextBox) = Format(CInt(frmPropProj.Controls(strCurrentTextBox)) + CInt(rsMValues.Fields("m" & intMCounter)), "000") 'Format("99", "000")
Else
frmPropProj.Controls(strCurrentTextBox) = rsMValues.Fields("m" & intMCounter)
End If
End If
'increment the year and month and find the next text box to fill.
'if the year is 2006 and the month is 12 then the next box to fill has a name
' txtjan2007xx
If intCurrentYear = 2006 And intCurrentMonth = 12 Then
intCurrentYear = 2007
intCurrentMonth = 1
strCurrentTextBox = "txtjan2007" & strFuncCode
'if the year is 2007 and the month is 12 then the next box to fill
'has a name txtFuturexx
ElseIf intCurrentYear = 2007 And intCurrentMonth = 12 Or (Left(strCurrentTextBox, 9) = "txtfuture") Then

strCurrentTextBox = "txtfuture" & strFuncCode
'if the year is 2006 or 2007 and the month is not 12 then
' the new month equals the old month plus 1 and the the next
' box to fill has a name txt(oldmonth+1)YearFuncCode
Else
intCurrentMonth = intCurrentMonth + 1
strCurrentTextBox = "txt" & fncStrMonth(intCurrentMonth) & intCurrentYear & strFuncCode
End If
Next intMCounter
End If
intCurrentMonth = Month(dtmEstStartDate)
intCurrentYear = Year(dtmEstStartDate)
Next intFuncCounter
End Sub

 

[tadimil]

Could I possibly trouble you to look at the following thread?

thread705-1185517

I am working on something similar and am having trouble. I'd appreciate any help...thanks in advance.