Problems with Array (probably syntax)

April15Hater

Accountant
Local time
Today, 16:17
Joined
Sep 12, 2008
Messages
349
Hey guys-
I'm pretty new to using arrays and I find them quite helpful, but this one has me really stumped. When I run 'MyVar = PayRates(0)' in the calling code, I get a 'Type Mismatch' error.

This is the abridged version of the calling code
Code:
Function ReconcileTimesheet(ProductionID As Long)
Dim PayRates As Variant
 PayRates = GetHourlyProduction(rsLiveData!CompleteDate, rsLiveData!ProductionInputDetailID, rsLiveData!ContractorID)
MyVar = PayRates(0)
End Function
Here is the full function that compiles the array.
Code:
Public Function GetHourlyProduction(datCompleteWeek As Date, lngProductionDetailID As Long, ContractorID As Long, Optional douProposedChange) As Variant
Dim rsProduction, rsHours  As ADODB.Recordset
Dim douProductionRate, douDefaultRate As Double
Dim PayRates(0 To 1)
Set rsProduction = New ADODB.Recordset
Set rsHours = New ADODB.Recordset
douDefaultRate = DLookup("DefaultRate", "tblProductionDetailTimesheet", "ProductionInputDetailID = " & lngProductionDetailID)
douProductionRate = DLookup("Cost", "tblProductionDetailTimesheet", "ProductionInputDetailID = " & lngProductionDetailID)
If IsMissing(douProposedChange) Then douProposedChange = 0
With rsHours
    .ActiveConnection = CurrentProject.Connection
    .Source = "SELECT sum(iif(TimeInDate < TimeOutDate, TimeOut - TimeIN + 24, TimeOut - TimeIn)) as TotalHours " _
            & "FROM tblContractorHours " _
            & "WHERE ContractorID = " & ContractorID & " AND " _
            & "TimeInDate BETWEEN #" & datCompleteWeek - 6 & "# AND #" & datCompleteWeek & "#;"
    .CursorType = adOpenKeyset
    .LockType = adLockOptimistic
    .Open
    douHourly = (douDefaultRate * !TotalHours)
End With

With rsProduction
    .ActiveConnection = CurrentProject.Connection
    .Source = "SELECT sum((tblProductionDetailTimesheet.Cost * tblProductionDetailTimesheet.ProductionUnits)) as ProductionCost " _
            & "FROM tblProductionTimesheet INNER JOIN tblProductionDetailTimesheet ON tblProductionTimesheet.ProductionID =  tblProductionDetailTimesheet.ProductionID " _
            & "WHERE ContractorID = " & ContractorID & " AND " _
            & "(CompleteDate BETWEEN #" & datCompleteWeek - 6 & "# AND #" & datCompleteWeek & "# OR tblProductionDetailTimesheet.Chargeback = True);"
    .CursorType = adOpenKeyset
    .LockType = adLockOptimistic
    .Open
    douProduction = !ProductionCost + douProposedChange * douProductionRate
End With
PayRates(0) = douHourly
PayRates(1) = Round(douProduction, 2)
DetermineHoursProduction = PayRates
End Function
 
I also tried a ?payrates(0) in the immediate window and I'm still having the problem.
 
Caveat: I don't usually deal with Arrays...

Code:
DetermineHoursProduction = PayRates

Maybe to make it more explicit, see if this works:

Code:
DetermineHoursProduction = PayRates[color=red]()[/color]

to ensure you are passing the array, not merely the first argument.

Also, inspect the PayRates inside the function to verify it's getting the right values. Furthermore, inspect whether MyVar & PayRates are reconigzed as an array by doing:

Code:
?VarType(MyVar)


Also, will it always be two things in an array? If so, I would just avoid the whole messy Variants & passing arrays and do something like this:

Code:
Public Type MyCustomType
   FieldOne As Long
   FieldTwo As String
End Type

Public Function GetIt(...) As MyCustomType

Dim Something As MyCustomType

...

Something.FieldOne = 123
Something.FieldTwo = "Hello, world!"

End Function

Public Sub DoIt()

Dim This As MyCustomType

This = GetIt(...)

Debug.Print This.FieldOne
Debug.Print This.FieldTwo

End Sub

Another caveat: I don't use UDT that often, but if you have a static structure and don't have to dynamically resize or use it for different purposes, it's great & convenient and definitely more efficient than variants.


Tangent: Did you see my last question in that other thread about .EOF?
 
Adding the parenthesis didn't do the trick. When i do ?VarType(PayRates), it returns 0 but i don't know what that means.

For that UDT idea...does that mean that I need to make a new UDT everytime I want to pass multiple variables? If you needed to pass multiple variables via say openargs, would you stilll use the UDT over the array?

RE Tangent, I repliedearlier, here's a repost:
1) Yes, we have some hanging on a '.movenext', maybe it doesn't 'open' per se until a command is thrown. Interesting.....

2) Nope... Not that good yet ;)

Glad we have some kind of closure on that EOF thing though.
 
Also tried this in the calling function:
Code:
Dim PayRates(0 To 1)

It jumps to this line:
Code:
PayRates = GetHourlyProduction(rsLiveData!CompleteDate, rsLiveData!ProductionInputDetailID, rsLiveData!ContractorID)
and highlights payrates and errors saying 'Can't assign to array.'
 
If you look in Help files in VBA Editor for "VarType", it lists what it means. In this context, it's "empty" as in that it was never assigned a value. If you tried this at the start of procedure, that's normal. We need to test that *after* the values are assigned to the PayTypes. It should be greater than 8192.

You need a new UDT for every different structure... Example:

Code:
Public Type MyUDT1
   FieldOne As Long
End Type

Public Type MyUDT2
   FieldOne As String
   FieldTwo As String
   FieldThree As Byte
End Type

Public Type MyUDT3
   FieldOne As Variant
   FieldTwo As Object
End Type

Otherwise for anything that uses same structure, you just need to declare a new variable of the same type as the UDT and assign primitive data type to the fields within the UDT.

As I said, it's great if you do not need the structure to change. If it's a general use and may contain different data types & used differently, then UDT may be a poor candidate.

As for OpenArgs... $##@! It only can pass a string, not a object or a UDT or even an array which makes everything even more messy. So, no, at least not without some serious leaning over backward.

Tangent: Hmm missed that reply but thanks for piquing my curiosity. :)
 
Also tried this in the calling function:
Code:
Dim PayRates(0 To 1)

It jumps to this line:
Code:
PayRates = GetHourlyProduction(rsLiveData!CompleteDate, rsLiveData!ProductionInputDetailID, rsLiveData!ContractorID)
and highlights payrates and errors saying 'Can't assign to array.'

Yes, that's normal. That's why we have to "cheat" by using Variant to pass around arrays.

However the PayRates inside the function maybe could be an array. See if this works.
 
OK, I got 8197 inside the array functionfor ?vartype(PayRates), but then in the calling function, for ?vartype(myvar) it returns 5 meaning double (which is what the individual parts of the array are dimmed in the array function). Then if i do just ?myvar it returns 0. If I do a ?myvar(0) it gives me Type Mismatch.

What did you want me to try? I think it got cut off.
 
Well, it's telling us that it wasn't correctly passed as an array. As I said I don't usually work with arrays, so I'm not sure why.

See if this helps give you any idea?

For all I know, it may be something silly as needing to declaring MyVar with a ()
Code:
Dim MyVar() As Variant
 
So I decided to go with the UDT but I'm having probs there too. I get the error "Compile Error: Only user-defined types defined in public object modules can be coerced to or from a variant or passed to late-bound functions." All while highlighting 'PayRates'

So I took it out of the new module I made, and pasted it in the object module where the function is located. That gave me a new error: "The expression On Click you entered as the event property produced the following error: Cannot define a Public user-defined type within an object module"

I put My new UDT in a new module:
Code:
Option Compare Database
''''''''''
'Naming Convention
'1) All User Defined Types start with tpe
'2) Dub = Double
'3) Sin = Single
'4) Str = String
'4) Int = Integer
'5) Var = Variant
'6) Lon = Long
'7) Dat = Date
'8) Boo = Boolean
''''''''''

Public Type tpeDubDub
    Field1 As Double
    Field2 As Double
End Type
The line we are concerned with is towards the end, you might want to search for 'PayRates':
Code:
Public Function ReconcileTimesheet(ProductionID As Long)

Dim rsTimesheetData, rsTimesheetDetailData, rsLiveData As ADODB.Recordset
Dim douTimesheetDifference As Double
Dim PayRates As tpeDubDub

Set rsLiveData = New ADODB.Recordset
Set rsTimesheetData = New ADODB.Recordset
Set rsTimesheetDetailData = New ADODB.Recordset

'''''Step 1 - Verify that the production contractor's timesheet has been finalized. If so, skip entire reconciliation process.  Timesheet data will be written when timesheet is finalized.
'Open Timesheet Data
With rsTimesheetData
    .ActiveConnection = CurrentProject.Connection
    .Source = "SELECT ProductionID " _
            & "FROM tblProductionTimesheet " _
            & "WHERE ProductionID = " & ProductionID
    .CursorType = adOpenDynamic
    .LockType = adLockOptimistic
    .Open
End With
If rsTimesheetData.EOF Then Exit Function
'''''Step 2 - Verify that both timesheet production archive and live data show the same billable functions in tblProductionTimesheetDetail
'Open Timesheet Detail Data
With rsTimesheetDetailData
    .ActiveConnection = CurrentProject.Connection
    .Source = "SELECT tblProductionDetailTimesheet.ProductionID, tblProductionDetailTimesheet.ContractorFunctionID, tblProductionDetailTimesheet.ProductionUnits, tblContractorFunction.FunctionType " _
            & "FROM tblContractorFunction INNER JOIN tblProductionDetailTimesheet ON tblContractorFunction.ContractorFunctionID = tblProductionDetailTimesheet.ContractorFunctionID " _
            & "WHERE ProductionID = " & ProductionID
    .CursorType = adOpenDynamic
    .LockType = adLockOptimistic
    .Open
End With
'Open Live Data
With rsLiveData
    .ActiveConnection = CurrentProject.Connection
    .Source = "SELECT tblProductionInput.FunctionID, tblProductionInput.ContractorID, tblProductionInput.QCContractorID, tblProductionInput.CompleteDate, tblProductionInput.InitiationDate, tblProductionInput.ClosingDate, tblProductionInput.FinalizeDate, tblProductionInput.Status, tblProductionInput.ProductionID, tblProductionInputDetail.ContractorFunctionID, tblProductionInputDetail.ProductionInputDetailID, tblProductionInputDetail.ProductionUnits, tblContractorFunction.FunctionType " _
            & "FROM tblProductionInput INNER JOIN (tblContractorFunction INNER JOIN tblProductionInputDetail ON tblContractorFunction.ContractorFunctionID = tblProductionInputDetail.ContractorFunctionID) ON tblProductionInput.ProductionID = tblProductionInputDetail.ProductionID " _
            & "WHERE tblProductionInput.ProductionID = " & ProductionID
    .CursorType = adOpenDynamic
    .LockType = adLockOptimistic
    .Open
End With
'Look for Aerial Data
DetailFunctionExists = False
rsTimesheetDetailData.MoveFirst
rsLiveData.MoveFirst
Do Until rsLiveData.EOF Or DetailFunctionExists = True
    If rsLiveData!FunctionType = "Aerial" Then
        If rsTimesheetDetailData.EOF Then SaveTimesheetDetailRecord cboFunctionSel, ProductionID, "Aerial"
        Do Until rsTimesheetDetailData.EOF Or DetailFunctionExists = True
            If rsTimesheetDetailData!FunctionType = "Aerial" Then DetailFunctionExists = True
            rsTimesheetDetailData.MoveNext
        Loop
        If Not DetailFunctionExists And rsTimesheetDetailData.EOF Then SaveTimesheetDetailRecord cboFunctionSel, ProductionID, "Aerial"
    End If
Loop
'Look for Underground Data
DetailFunctionExists = False
rsTimesheetDetailData.MoveFirst
rsLiveData.MoveFirst
Do Until rsLiveData.EOF Or DetailFunctionExists = True
    If rsLiveData!FunctionType = "Underground" Then
        If rsTimesheetDetailData.EOF Then SaveTimesheetDetailRecord cboFunctionSel, ProductionID, "Underground"
        Do Until rsTimesheetDetailData.EOF Or DetailFunctionExists = True
            If rsTimesheetDetailData!FunctionType = "Underground" Then DetailFunctionExists = True
            rsTimesheetDetailData.MoveNext
        Loop
        If Not DetailFunctionExists And rsTimesheetDetailData.EOF Then SaveTimesheetDetailRecord cboFunctionSel, ProductionID, "Underground"
    End If
    rsLiveData.MoveNext
Loop
'Look for Unit Data
DetailFunctionExists = False
rsTimesheetDetailData.MoveFirst
rsLiveData.MoveFirst
Do Until rsLiveData.EOF Or DetailFunctionExists = True
    If rsLiveData!FunctionType = "Unit" Then
        If rsTimesheetDetailData.EOF Then SaveTimesheetDetailRecord cboFunctionSel, ProductionID, "Unit"
        Do Until rsTimesheetDetailData.EOF Or DetailFunctionExists = True
            If rsTimesheetDetailData!FunctionType = "Unit" Then DetailFunctionExists = True
            rsTimesheetDetailData.MoveNext
        Loop
        If Not DetailFunctionExists And rsTimesheetDetailData.EOF Then SaveTimesheetDetailRecord cboFunctionSel, ProductionID, "Unit"
    End If
    rsLiveData.MoveNext
Loop
'Look for Setup Data
DetailFunctionExists = False
rsTimesheetDetailData.MoveFirst
rsLiveData.MoveFirst
Do Until rsLiveData.EOF Or DetailFunctionExists = True
    If rsLiveData!FunctionType = "Setup" Then
        If rsTimesheetDetailData.EOF Then SaveTimesheetDetailRecord cboFunctionSel, ProductionID, "Setup"
        Do Until rsTimesheetDetailData.EOF Or DetailFunctionExists = True
            If rsTimesheetDetailData!FunctionType = "Setup" Then DetailFunctionExists = True
            rsTimesheetDetailData.MoveNext
        Loop
        If Not DetailFunctionExists And rsTimesheetDetailData.EOF Then SaveTimesheetDetailRecord cboFunctionSel, ProductionID, "Setup"
    End If
    rsLiveData.MoveNext
Loop
rsLiveData.MoveFirst
rsTimesheetDetailData.MoveFirst
'''''Step 3 - Verify that units are the same amongst the timesheet production archive and the live data
With rsLiveData
    'Loop Live Data
    Do Until .EOF
        'Loop Timesheet Data until the ContractorFunctionID's match.  There will always be a match because of the Step 1 processes.
        rsTimesheetDetailData.MoveFirst
        Do Until rsTimesheetDetailData.EOF
            douTimesheetDifference = CDbl(rsLiveData!ProductionUnits - rsTimesheetDetailData!ProductionUnits)
            If rsLiveData!ContractorFunctionID = rsTimesheetDetailData!ContractorFunctionID And rsLiveData!ProductionUnits <> rsTimesheetDetailData!ProductionUnits Then
                PayRates = GetHourlyProduction(rsLiveData!CompleteDate, rsLiveData!ProductionInputDetailID, rsLiveData!ContractorID)
                ProposedPayRates = GetHourlyProduction(rsLiveData!CompleteDate, rsLiveData!ProductionInputDetailID, rsLiveData!ContractorID, douTimesheetDifference)
                'Determine how the contractor was originally paid.
                If PayRates.Field1 > PayRates.Field2 Then TimsheetHourly = True
                If PayRates.Field1 < PayRates.Field2 Then TimesheetProduction = True
                'Determine whether the proposed chargeback changes whether the contractor's paycheck should be hourly or production
                If ProposedPayRates(0) > ProposedPayRates(1) Then PropTimesheetHourly = True
                If ProposedPayRates(0) < ProposedPayRates(1) Then PropTimesheetProduction = True
                'Timesheet Adjustments
                If TimesheetProduction And PropTimesheetHourly Then SaveTimesheetDetailRecord rsLiveData!ContractorFunctionID, rsLiveData!ProductionID, PayRates(0) - PayRates(1): rsTimesheetDetailData!ProductionUnits = douTimesheetDifference - (PayRates(0) - PayRates(1)) 'New Timesheeet Record = Hourly - Production : Update Timesheet Archive = Total Difference - New Timesheet Record
                If TimesheetProduction And PropTimesheetProduction Then SaveTimesheetDetailRecord rsLiveData!ContractorFunctionID, rsLiveData!ProductionID, douTimesheetDifference 'New Record for the full amount
                If TimesheetHourly And PropTimesheetProduction Then SaveTimesheetDetailRecord rsLiveData!ContractorFunctionID, rsLiveData!ProductionID, douTimesheetDifference 'New Record for the full amount
                If TimesheetHourly And PropTimesheetHourly Then rsTimesheetDetailData!ProductionUnits = rsLiveData!ProductionUnits: rsTimesheetDetailData.Update
            End If
            rsTimesheetDetailData.MoveNext
        Loop
        .MoveNext
    Loop
End With
End Function

EDIT: Here's the code for the Function-

Code:
Public Function GetHourlyProduction(datCompleteWeek As Date, lngProductionDetailID As Long, ContractorID As Long, Optional douProposedChange) As tpeDubDub
'Dim douProductionRate, douDefaultRate As Double
Dim PayRates As tpeDubDub
Set rsProduction = New ADODB.Recordset
Set rsHours = New ADODB.Recordset
douDefaultRate = DLookup("DefaultRate", "tblProductionDetailTimesheet", "ProductionInputDetailID = " & lngProductionDetailID)
douProductionRate = DLookup("Cost", "tblProductionDetailTimesheet", "ProductionInputDetailID = " & lngProductionDetailID)
If IsMissing(douProposedChange) Then douProposedChange = 0
With rsHours
    .ActiveConnection = CurrentProject.Connection
    .Source = "SELECT sum(iif(TimeInDate < TimeOutDate, TimeOut - TimeIN + 24, TimeOut - TimeIn)) as TotalHours " _
            & "FROM tblContractorHours " _
            & "WHERE ContractorID = " & ContractorID & " AND " _
            & "TimeInDate BETWEEN #" & datCompleteWeek - 6 & "# AND #" & datCompleteWeek & "#;"
    .CursorType = adOpenKeyset
    .LockType = adLockOptimistic
    .Open
    douhourly = (douDefaultRate * !TotalHours)
End With

With rsProduction
    .ActiveConnection = CurrentProject.Connection
    .Source = "SELECT sum((tblProductionDetailTimesheet.Cost * tblProductionDetailTimesheet.ProductionUnits)) as ProductionCost " _
            & "FROM tblProductionTimesheet INNER JOIN tblProductionDetailTimesheet ON tblProductionTimesheet.ProductionID =  tblProductionDetailTimesheet.ProductionID " _
            & "WHERE ContractorID = " & ContractorID & " AND " _
            & "(CompleteDate BETWEEN #" & datCompleteWeek - 6 & "# AND #" & datCompleteWeek & "# OR tblProductionDetailTimesheet.Chargeback = True);"
    .CursorType = adOpenKeyset
    .LockType = adLockOptimistic
    .Open
    douProduction = !ProductionCost + douProposedChange * douProductionRate
End With
PayRates.Field1 = douhourly
PayRates.Field2 = Round(douProduction, 2)
DetermineHoursProduction = PayRates
End Function
 
Joe, I'm sorry for the frustration.

As you found out, you can't convert a UDT into variant and it has to be declared in a public standard module.

However, you just want to pass it as the UDT, which I see you already did.

I just tried it out and calling the function from a form and it works. It will work even though the UDT is defined in a standard module. I moved the function into the form and left UDT in the standard module and it works.

Did you try either?
 
Yes, I actually realized after the fact that GetHourlyProduction function was still variant. I changed it to tpeDubDub but no dice. Maybe I have my functions in the wrong place. I have GetHourlyProduction in a standard mod, the udt in a different standard mod, and ReconcileTimesheet in the object mod.
 
Hmm.


Can't see what else would be wrong.

Let's try this: Write a new UDT, then a function inside the object module and call it somewhere in the form. Maybe display a messagebox listing all fields in the UDT for instance. See if you can get that working. Maybe it'll also help point out what was missing?
 
Well....here's what I did:
Code:
Public Type MyCustomType
    Field1 As Double
    Field2 As Double
End Type

Code:
Public Function GetIt() As MyCustomType
Dim something As MyCustomType
something.Field1 = 1
something.Field2 = 2
End Function
Public Sub doit()
Dim this As MyCustomType
this = GetIt
MsgBox this.Field1
MsgBox this.Field2

End Sub

the msgbox's showed the wrong values though, they showed 0's rather than 1 and 2
 
It's missing the return statement:


Code:
Public Function GetIt() As MyCustomType
Dim something As MyCustomType
something.Field1 = 1
something.Field2 = 2
[color=red]GetIt = something[/color]
End Function

Add that line and the value will display correctly.
 
What about the actual production code? Did you figure that out as well?
 
No, but I did find another problem with it. I replaced:
Code:
DetermineHourlyProduction = PayRates
with
Code:
GetHourlyProduction = PayRates
But still getting the "Compile Error: Only user-defined types defined in public object modules can be coerced to or from a variant or passed to late-bound functions." errorwhile highlighting PayRates in the Calling Function (reconciletimesheet)
 
I got it!!! Fairly bizzarre, but I took
Code:
Dim udtPayRates, udtProposedPayRates As tpeDubDub
and changed it to
Code:
Dim udtPayRates As tpeDubDub
Dim udtProposedPayRates As tpeDubDub
and voila!
 
Do you have a variant or something that doesn't match up in the calling syntax? It looks all right to me in the code you pasted few posts above but maybe it got changed since?

Also, try calling the function in a new sub doing just one thing; calling that function. Do that in the object module. If there's an error, try that in the standard module. See if you can rule out whether it's syntax or something else interfering with the calling.


EDIT: Saw your recent post.

Glad you worked it out.

The reason is that it doesn't do what you think it does.

Code:
Dim a, b As Integer

is semantically equivalent to this:
Code:
Dim a As Variant
Dim b As Integer

To do multiple declaration on a line:
Code:
Dim a As Integer, b As Integer

But it's usually best to declare one variable per line anyway because of that confusion you ran into...

Glad again you got it worked out.
 

Users who are viewing this thread

Back
Top Bottom