Passing a string to a public subrountine 3

[IanMWheeler]

Hi there

I am trying to develop a public sub routine to display messages to the users while long bits of code runs.
The idea is I that I declare the string of Text like "reviewing records..." etc in my private sub and pass it out to the public sub routine to display. I have used a sub routine as there is nothing to pass back to the private subroutine

I have tested the code without passing the message string ok, the form opens and returns (seen in debug.print) but now I can not pass the txt, I have googled but all refs seem to be on functions with the line
Call MsgFormSub(strTxt as string)
but when I try this I get error!

if I try - Call MsgFormSub(strTxt)I get a error for the wrong number of arguments!

I have a couple of real basic question also
1. How do I execute my private subroutine in Visual Basic window direct? To run my code I have to go back to access and press the button to trigger the code, this does not seem right.
2. Rather than declaring a rs and writting the txt message to a table there must be a better way of loading the txt message to a text box control direct, but how?

The code is as follows
from the private sub

Private Sub Command88_Click()
Dim strTxt As String
strTxt = "Test Send"
'Go to msgform sub
Debug.Print "goto msgform"
Call MsgFormSub(strTxt)
debug.Print "return msgform"

Public Routine
Public Sub MsgFormSub()

'This code should be passed the msgTxt from another rountine
'The msgTxt should be written to the table then displayed on the form to inform the user wht is going on while longer code runs

Dim stDocName As String
Dim strTxt As String
Dim dbmsg As DAO.Database
Dim msgrst As DAO.Recordset
Dim strmsgSql As String
Dim stLinkCriteria As String

Debug.Print "arrive at sub routine"
strTxt = "Sales Demand Table Written"
Debug.Print strTxt
stDocName = "SystemMessage"
strmsgSql = "SELECT Msgtxt.MsgTxt FROM Msgtxt"
Set dbmsg = CurrentDb()
Set msgrst = dbmsg.OpenRecordset(strmsgSql, dbOpenDynaset)
With msgrst
.Edit
!MsgTxt = strTxt
.Update
End With
DoCmd.OpenForm stDocName, , , stLinkCriteria
DoCmd.RunCommand acCmdRefresh

' run a loop to display the message
i = 0
For i = 1 To 100000000
i = i + 1
Next


DoCmd.Close

Debug.Print "End of sub"

End Sub

Many thanks


A person new to crystal with very little training a part from Access based

Regards
Ian

 

[MajP]

currently you have a 0 parameter sub. So change

Public Sub MsgFormSub()
end sub

to

Public Sub MsgFormSub(strMsg as string)
end sub

now call it as
call MsgFormSub("literalString")
or
call MsgFormSub(variableString)

you can drop the call keyword but if you do that you have to drop parentheses

msgFormSub "literalString"
or
MsgFormSub variableString

 

[IanMWheeler]

Ok I see, any limits on the number of parameter you can pass?

Many thanks for the help I will give it a go



A person new to crystal with very little training a part from Access based

Regards
Ian

 

[MajP]

1. How do I execute my private subroutine in Visual Basic window direct? To run my code I have to go back to access and press the button to trigger the code, this does not seem right.

A sub on a form is a class method. So you have to reference the class.
Forms("yourFormName").methodName


2. Rather than declaring a rs and writting the txt message to a table there must be a better way of loading the txt message to a text box control direct, but how?
dim msg as string
'some code that generates your message
' msg = ...
'if form is not open then open it first
Forms("someForm").textBoxName.text = msg

if you open the form as acdialog there will be some other issues because you can not set values on a form opened as dialog.

 

[MajP]

no limits. If the amount is variable and the limit is unknown you can also use a parameter array. If the amount is variable and the limit is known you can use optional parameters. You can google Optional and Parameter Array for discussion.

 

[Andrzejek]

Also, as a side note, you did:

Private Sub Command88_Click()
[blue]Dim strTxt As String[/blue]
...
And Sub

and

Public Sub MsgFormSub()
Dim stDocName As String
[blue]Dim strTxt As String[/blue]
...
End Sub

And here is just my guess: you may had expected to pass the value of strTxt from Command88_Click to MsgFormSub since it has the same name of variable. Am I right?
If that's the case, it does not work this way. Both variables *live* (have a scope) only in the event, and not outside of the event.

But as I said, it is only my guess of what you were trying to accomplich....

Have fun.

---- Andy

 

[IanMWheeler]

Thanks Andy

you where correct - I shall remember that

A person new to crystal with very little training a part from Access based

Regards
Ian

 

[TheAceMan1]

How are ya IanMWheeler . . .

I'd like to present a more fluid means of performing your task. The steps involve ...
[ol][li]Passing the string to [blue]MsgFormSub[/blue] as already presented by [blue]MajP[/blue].[/li]
[li]Appending the string to [blue]MSGtxt[/blue] using and append SQL statement.[/li]
[li]Passing the string to [blue]SystemMessage[/blue] via the last argument ([blue]OpenArgs[/blue]) of the [blue]DoCmd.OpenForm[/blue] method.[/li]
[li]In the [blue]On Load[/blue] event of [blue]SystemMessage[/blue] we do two things:
[ol a][li]Write [blue]OpenArgs[/blue] to your display control.[/li]
[li]Set the forms [blue]Timer Interval[/blue] property for a desired display period. In the code I'll use 3secs as an example (the setting is in milliseconds so it'll be 3000).[/li][/ol][/li]
[li]Finally ... in the [blue]On Timer[/blue] event of [blue]SystemMessage[/blue] we close the form (when the timer triggers).[/li]
[li][blue]Thats it ...[/blue][/li][/ol]
With the above in mind, the code for [blue]MsgFormSub[/blue] changes to:

[blue]Public Sub MsgFormSub([purple][b]strTxt[/b][/purple])
   Dim db As DAO.Database, SQL As String
   
   Set db = CurrentDb()
   
   SQL = "INSERT INTO MSGtxt (MSGtxt) " & _
         "VALUES('" & [purple][b]strTxt[/b][/purple] & "');"
   db.Execute SQL, dbFailOnError
   
   DoCmd.OpenForm "SystemMessage", , , , , acDialog, [purple][b]strTxt[/b][/purple]
   
   Set db = Nothing

End Sub[/blue]

Next ... in the [blue]On Load[/blue] event of [blue]SystemMessage[/blue] we have ... note: you substitute proper name for [purple]YourControlName[/purple]:

[blue]   Me.[purple][b]YourControlName[/b][/purple] = Me.OpenArgs
   Me.TimerInterval = 3000[/blue]

Finnaly in the [blue]On Timer[/blue] event of [blue]SystemMessage[/blue] you have:

[blue]   DoCmd.Close acForm, "SystemMessage", acSaveNo[/blue]

Aside from a few other things ... your [blue]naming convention[/blue] really needs to be better.

[blue]Your Thoughts? . . .[/blue]

See Ya! . . . . . .

Be sure to see faq219-2884 [blue]Worthy Reading![/blue]
Also faq181-2886 [blue]Worthy Reading![/blue]

 

[IanMWheeler]

Hi there TheAceMan1

My thoughts are in two stages

1. Thanks, this is exactly what I need to help me try and improve what I do. I am actually no more than an engineer who is a technical user, I have ended up down this road because my current system does not always present the info how my company needs it and in 1997 I was trained on vb for 1 day, and have since forgotten most of it. I will give this a go and let you now if I have a problem

2. You mention my naming convention could be improved - have you any links or pointers?

Thanks





A person new to crystal with very little training a part from Access based

Regards
Ian

 

[TheAceMan1]

IanMWheeler . . .

You can get a ton of info on naming convention by googling [blue]access naming convention[/blue]. Following are just a few.

Commonly used naming conventions What naming conventions do you use?

Naming convention is not meant to be a hardcore rule infested thing to do. In fact ... the end result of whatever you use is [blue]readability to you[/blue]. You don't want to decipher your code ... you want to read it directly. Remember, your the programmer and you'll be reading your code again and again.

There are other factors to get a grip on:
[ol][li][blue]Short names[/blue] are always best. A page full of long names will be offensive and put you in decipher mode. Something you'll never like.[/li]
[li][blue]Formatting[/blue] of your code. This has a direct effect on readability and can make it harder or easier.[/li]
[li]Use [blue]no spaces[/blue] in your convention. Capitalize the 1st letter of key words.[/li]
[li]Always [blue]indent[/blue] the body of loops.[/li][/ol]
These are just some of the things you'll get use to as you go along.

See Ya! . . . . . .

Be sure to see faq219-2884 [blue]Worthy Reading![/blue]
Also faq181-2886 [blue]Worthy Reading![/blue]

 

[Andrzejek]

"naming convention" - I would say: name your controls appropriately if they are mentioned in the code. [tt]Command88[/tt] is not the best name for the command button, [tt]cmdDelete[/tt] or [tt]cmdAddEmployee[/tt] - that's a different story


Have fun.

---- Andy

 

[IanMWheeler]

Ok guys I am going to defend myself here, but I do have a serious question as well, at the bottom is a bit of vb I am working on to show my naming convention, and I think I am ok, but comments welcome.

However the serious point. The only way I have been able to get to vb is to use the "button" wizard on the design page of access. When you do that access puts in the generic title of Command88 etc, see below. I have always wanted to rename this segment of code but have been worried to do so. In the end I delete the code that has been inserted and then write my own (very backward but it works!). Better methods very welcome please

Thanks, this post has been really useful

From Access button wizard

Private Sub Command89_Click()
On Error GoTo Err_Command89_Click

Dim stDocName As String
Dim stLinkCriteria As String

stDocName = "CA Orders"
DoCmd.OpenForm stDocName, , , stLinkCriteria

Exit_Command89_Click:
Exit Sub

Err_Command89_Click:
MsgBox Err.Description
Resume Exit_Command89_Click

End Sub

My code I am working on just to prove out my naming convention

'This code is to assign FG stock to orders
Dim db As DAO.Database
Dim db1 As DAO.Database
Dim rst As DAO.Recordset
Dim rst1 As DAO.Recordset
Dim rst2 As DAO.Recordset
Dim strSelect As String
Dim strOrder As String
Dim strWhere As String
Dim strSql As String
Dim strSelect1 As String
Dim strOrder1 As String
Dim strWhere1 As String
Dim strSql1 As String
Dim intFG As Integer
Dim intInsp As Integer
Dim intHold As Integer
Dim intOffSite As Integer
Dim intRaw As Integer
Dim Scrap As Double
Dim stDocName As String
Dim strTxt As String
Dim dbmsg As DAO.Database
Dim msgrst As DAO.Recordset
Dim strmsgSql As String
Dim stLinkCriteria As String
Dim intRecNo As Integer
y = 1



strTxt = "Reviewing the order lines covered by stock"
'Go to msgform sub
Debug.Print "goto msgform"
Call MsgFormSub(strTxt)
Debug.Print "return msgform"

'Stage 1 create the order demand table -TURN BACK ON AT END OF TESTING
stDocName = "QrySalesOrders"
DoCmd.OpenQuery stDocName, acNormal, acEdit
Debug.Print "Sales Demand Table Written"

'Stage 2a load the FGparts on order

strSql = "SELECT dbo_CHCIW_AllStock.Stockcode, dbo_CHCIW_AllStock.FinishedQty, dbo_CHCIW_AllStock.Comp FROM dbo_CHCIW_AllStock where (((dbo_CHCIW_AllStock.FinishedQty)>0)) or ((dbo_CHCIW_AllStock.Comp)>0) order by dbo_CHCIW_AllStock.Stockcode "
Set db = CurrentDb()
Set rst = db.OpenRecordset(strSql, dbOpenDynaset)
'find number of records
rst.MoveFirst
rst.MoveLast
strTxt = "2a - The number of parts with stock are " & rst.RecordCount & " to review"
Debug.Print strTxt
'Go to msgform sub
Debug.Print "2b-goto msgform"
Call MsgFormSub(strTxt)
Debug.Print "2c-return msgform"
rst.MoveFirst

With rst

While Not .EOF
Debug.Print rst!StockCode; " FG="; rst!FinishedQty; " Comp="; rst!Comp
rst.MoveNext
Wend
Debug.Print "2d-End of records"
rst.MoveFirst
While Not rst.EOF

A person new to crystal with very little training a part from Access based

Regards
Ian

 

[MajP]

If you rename your controls before running the wizard then you will have "good names" in your code

A with block allows you to drop the object name. But some places you drop "rst" as in "... Not .eof", and others you put it back in "rst.moveNext".

With rst
While Not .EOF
Debug.Print rst!StockCode; " FG="; rst!FinishedQty; " Comp="; rst!Comp
rst.MoveNext
Wend

 

[IanMWheeler]

Yes I see what you mean. but I have three sets of records I am working with in my code at the same time, so I have kept the rst.EOF the rst1 and rst2 and so to help me know what rs I am working with

I will try out the rename idea though so good

Thanks

A person new to crystal with very little training a part from Access based

Regards
Ian

 

[MajP]

I do not understand your reply because there is only "rst" in the code.

The proper construct is

With SomeObject
  .property
  .otherPropertyOrMethod
  ...
end with

not

with SomeObject
   Someobject.property
   Someobject.otherPropertyOrMethod
   ....
end with

You do not repeat the object variable inside the with block, that is the purpose of the with block. I am not even sure if the latter would compile, but if it does then you are just wasting code, and making it very difficult to read.

 

[IanMWheeler]

Hi there sorry this is not clear

The code you are looking at is snippet of the full code I am working on. I have three record sets
The first rs finds all the stockcodes on order
A loop then starts for the stockcodes on order
the second rs loads the stockcode inventory levels
the third rs loads all the detailed order lines and starts a loop to calculate the stock coverage for eight types of stock levels (stages of our production)
the stock cover gets loaded into the detailed order line record and then next order line is considered untill all the inventory at each stage is depleted
the loop close
and then it moves onto the next stockcode

I am finding difficult to read the code and am doing all the things suggested such and indents etc, I can post the code if you want it not complete but if it helps

sorry if I am not clear about this but it is really all new to me

many thanks for all the help though



A person new to crystal with very little training a part from Access based

Regards
Ian

 

[PHV]

As for indentation:

http://www.oaltd.co.uk/Indenter/Default.htm

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[Andrzejek]

And please format your code in the posts:
[ignore]

[/ignore]
[code]
Some Code goes here....

[ignore][/code][/ignore]


Have fun.

---- Andy

 

[IanMWheeler]

ok here goes not sure if I am doing this right

I am having real problem with loops in inside loops and my select case is not quite working yet

I am very sorry if it is messy but I am really making this up as I go along!

Your comment (try and be positive please I already know it is not great coding, but you should have seen it before this post !) are welcome

Private Sub Command88_Click()
On Error GoTo Err_Command88_Click
'This code is to assign FG stock to orders
    Dim db As DAO.Database
    Dim db1 As DAO.Database
    Dim rst As DAO.Recordset
    Dim rst1 As DAO.Recordset
    Dim rst2 As DAO.Recordset
    Dim strSelect As String
    Dim strOrder As String
    Dim strWhere As String
    Dim strSql As String
    Dim strSelect1 As String
    Dim strOrder1 As String
    Dim strWhere1 As String
    Dim strSql1 As String
    Dim intFG As Integer
    Dim intInsp As Integer
    Dim intHold As Integer
    Dim intOffSite As Integer
    Dim intRaw As Integer
    Dim Scrap As Double
    Dim stDocName As String
    Dim strTxt As String
    Dim dbmsg As DAO.Database
    Dim msgrst As DAO.Recordset
    Dim strmsgSql As String
    Dim stLinkCriteria As String
    Dim intRecNo As Integer
    Dim intStock As Integer
    Dim intDemand As Integer
    Dim strStockFlag As String
    
    
    y = 1
    
    
    
strTxt = "Reviewing the order lines covered by stock"
'Go to msgform sub
Debug.Print "goto msgform"
Call MsgFormSub(strTxt)
Debug.Print "return msgform"

'Stage 1 create the order demand table
stDocName = "QrySalesOrders"
DoCmd.OpenQuery stDocName, acNormal, acEdit
Debug.Print "Sales Demand Table Written"

'Stage 2a load the FGparts on order

strSql = "SELECT dbo_CHCIW_AllStock.Stockcode, dbo_CHCIW_AllStock.FinishedQty, dbo_CHCIW_AllStock.Comp FROM dbo_CHCIW_AllStock where (((dbo_CHCIW_AllStock.FinishedQty)>0)) or ((dbo_CHCIW_AllStock.Comp)>0) order by dbo_CHCIW_AllStock.Stockcode "
Set db = CurrentDb()
Set rst = db.OpenRecordset(strSql, dbOpenDynaset)
'find number of records
rst.MoveFirst
rst.MoveLast
strTxt = "2a - The number of parts with stock are " & rst.RecordCount & " to review"
Debug.Print strTxt
'Go to msgform sub
Debug.Print "2b-goto msgform"
Call MsgFormSub(strTxt)
Debug.Print "2c-return msgform"
rst.MoveFirst

With rst

    While Not .EOF
    Debug.Print rst!StockCode; " FG="; rst!FinishedQty; " Comp="; rst!Comp
    rst.MoveNext
    Wend
    Debug.Print "2d-End of records"
    rst.MoveFirst
    While Not rst.EOF
    
    
    
    'Stage 2b load the FG stock on for !MStockCode
    'This needs to go in loop
        strSelect = "SELECT dbo_CHCIW_AllStock.Stockcode, dbo_CHCIW_AllStock.FinishedQty, dbo_CHCIW_AllStock.Comp FROM dbo_CHCIW_AllStock "
        strWhere = "Where (dbo_CHCIW_AllStock.Stockcode = '" & RTrim(rst!StockCode) & "')"
        strSql = strSelect + strWhere
       
        Debug.Print "2e-"; strSql
        Set rst1 = db.OpenRecordset(strSql, dbOpenDynaset)
        intFG = rst1!FinishedQty + rst1!Comp
        Debug.Print "2f-"; rst1!StockCode; " FG Stock=" & intFG
        
    'Stage 2c - Load the sales order for MStockCode
    
        strSelect = "SELECT TblSalesDemand.MStockCode, TblSalesDemand.MLineShipDate, TblSalesDemand.MBackOrderQty, TblSalesDemand.FG, TblSalesDemand.StockFlag, TblSalesDemand.Priority FROM TblSalesDemand "
        strOrder = "ORDER BY TblSalesDemand.MStockCode, TblSalesDemand.MLineShipDate "
        strWhere = "Where (((TblSalesDemand.MStockCode) ='" & RTrim(rst1!StockCode) & "'))"
        strSql = strSelect + strWhere + strOrder
       
        Debug.Print "2g-"; strSql
        Set rst2 = db.OpenRecordset(strSql, dbOpenDynaset)
        With rst2
        'find number of records
        
        If rst2.RecordCount > 0 Then rst2.MoveFirst
        If rst2.RecordCount > 0 Then rst2.MoveLast
        If rst2.RecordCount > 0 Then strTxt = "2h-The number order lines are " & rst2.RecordCount & " to review" Else
            strTxt = "2h-There are no order lines to review " & rst2.RecordCount
        Debug.Print strTxt
        intRec = rst2.RecordCount
        If rst2.RecordCount > 0 Then rst2.MoveFirst
        While Not rst2.EOF
        Debug.Print RTrim(rst2!MStockCode); " "; rst2!MLineShipDate; " "; rst2!MBackOrderQty; " FG Stock "; rst2!FG; " Flag "; rst2!StockFlag
        If rst2.RecordCount > 0 Then rst2.MoveNext
        Wend
        Debug.Print "2i- End of records"
         If rst2.RecordCount > 0 Then rst2.MoveFirst
        
        'consider the stock
        For i = 0 To (intRec)
        If rst2.RecordCount > 0 Then
        rst2.Edit
        If intFG >= rst2!MBackOrderQty Then rst2!StockFlag = "G"
        If intFG >= rst2!MBackOrderQty Then rst2!FG = rst2!MBackOrderQty
        If intFG < rst2!MBackOrderQty Then rst2!StockFlag = "R"
        If intFG < rst2!MBackOrderQty Then rst2!FG = intFG
        Debug.Print "2j"; i; " stock calc="; intFG; " - "; rst2!MBackOrderQty; " = "; intFG - rst2!MBackOrderQty
        rst2.Update
        If intFG - rst2!MBackOrderQty > 0 Then intFG = intFG - rst2!MBackOrderQty Else intFG = 0
        
        Debug.Print "2j"; i; " "; rst2!MLineShipDate; " "; rst2!MBackOrderQty; " FG Stock "; rst2!FG; " Flag "; rst2!StockFlag; " remaining FG Stock "; intFG
        If intFG = 0 Then rst2.MoveLast
        If intFG > 0 Then rst2.MoveNext
        End If
        i = i + 1
            
        'MsgBox (RTrim(rst!Stockcode) & " " & rst2.EOF & " " & rst2.RecordCount) & " i= " & i
               
       Next i
        
        Debug.Print "2K - Order lines Now Considered for "; rst!StockCode
    
    
    End With
    Debug.Print "2l - Move to next stock code"
    
    rst.MoveNext
    y = y + 1
    strTxt = "2m-record " & y & " out of " & rst.RecordCount & " reviewed"
    Debug.Print strTxt
    'Go to msgform sub
    Debug.Print "2b-goto msgform"
    Call MsgFormSub(strTxt)
    Debug.Print "2c-return msgform"
    
    Wend
    
    End With
    
    'Stage 3 Consider the CA stock against the orders remember ca parts can have more than one FG
    
        y = 1
    'stage 3a find the ca parts with orders not covered by FG stock
    strSql = "SELECT TblSalesDemand.Component FROM TblSalesDemand WHERE (((TblSalesDemand.MBackOrderQty) > 0)) GROUP BY TblSalesDemand.Component"
    Set rst = db.OpenRecordset(strSql, dbOpenDynaset)
    rst.MoveLast
    rst.MoveFirst
    
    strTxt = "Stage 3 - There are " & rst.RecordCount & " CA records to evaluate"
    'MsgBox sqlTxt
    'MsgBox strTxt
    Debug.Print strTxt
    'Go to msgform sub
    Debug.Print "3-goto msgform"
    Call MsgFormSub(strTxt)
    Debug.Print "3-return msgform"
    
    'stage 3b load the ca stock
    intRecNo = 1
    
        While Not rst.EOF
        sqlSelect = "SELECT dbo_CHCIW_AllStock.CAStockCode, dbo_CHCIW_AllStock.Problem, dbo_CHCIW_AllStock.Hold, dbo_CHCIW_AllStock.Insp, dbo_CHCIW_AllStock.SCret, dbo_CHCIW_AllStock.Offsite, dbo_CHCIW_AllStock.SCtogo, dbo_CHCIW_AllStock.ToFettle, dbo_CHCIW_AllStock.Scun FROM dbo_CHCIW_AllStock"
        sqlWhere = " WHERE (((dbo_CHCIW_AllStock.CAStockCode) = '" & RTrim(rst!Component) & "'))"
        strSql = sqlSelect + sqlWhere
        'MsgBox (strSql)
        Set rst1 = db.OpenRecordset(strSql, dbOpenDynaset)
        Debug.Print "Stock info: " & RTrim(rst1!CAStockCode) & " Problem=" & rst1!Problem & " Hold=" & rst1!Hold & " Insp=" & rst1!Insp & " SCret=" & rst1!SCret & " Offsite=" & rst1!Offsite & " SCtogo=" & rst1!SCtogo & " ToFettle=" & rst1!ToFettle & " Scun=" & rst1!Scun
    
   'stage 3c - load the order rs for the ca parts
   
        sqlSelect = "SELECT TblSalesDemand.Component, TblSalesDemand.MLineShipDate, TblSalesDemand.MBackOrderQty, TblSalesDemand.FG, TblSalesDemand.Problem, TblSalesDemand.Hold, TblSalesDemand.Insp, TblSalesDemand.SCret, TblSalesDemand.Offsite, TblSalesDemand.SCtogo, TblSalesDemand.Raw, TblSalesDemand.Scun, TblSalesDemand.StockFlag FROM TblSalesDemand "
        sqlWhere = "WHERE (((TblSalesDemand.MBackOrderQty) > 0)and ((TblSalesDemand.Component) = '" & RTrim(rst!Component) & "'))"
        sqlOrder = " ORDER BY  TblSalesDemand.MLineShipDate, TblSalesDemand.MBackOrderQty "
        strSql = sqlSelect + sqlWhere + sqlOrder
        Debug.Print sqlTxt
        'MsgBox (strSql)
    
       
        Set rst2 = db.OpenRecordset(strSql, dbOpenDynaset)
            rst2.MoveFirst
            rst2.MoveLast
            MsgBox ("rst2 records" & rst2.RecordCount)
            
            With rst2
            
            .MoveFirst
            For i = 1 To .RecordCount
            Debug.Print i & " " & RTrim(rst2!Component) & " Date " & rst2!MLineShipDate & " Qty " & rst2!MBackOrderQty & "FG= " & rst2!FG & " Problem=" & rst2!Problem & " Hold= " & rst2!Hold & " Insp= " & rst2!Insp & " Scret=" & rst2!SCret & "Offsite= " & rst2!Offsite & " Sctogo =" & rst2!SCtogo & " Raw= " & rst2!Raw & " Scun =" & rst2!Scun & "StockFlag =" & rst2!StockFlag
            .MoveNext
            
            Next i
            
            rst2.MoveFirst
            End With
        strTxt = "Stage 3c - Evaluating record " & intRecNo & " out of " & rst.RecordCount & " CA records, StockCode: " & RTrim(rst!Component)
        'Debug.Print strTxt
        'Go to msgform sub
        'Debug.Print "3-goto msgform"
        Call MsgFormSub(strTxt)
        Debug.Print "3-return msgform"
            
        
        'Stage 3d start a loop for each order line to see if covered by stock
        
        
            For y = 1 To 8
            strStockFlag = ""
                    Select Case AssignStock
            
                        Case y = 1
                            intStock = rst1!Insp
                            intDemand = rst2!MBackOrderQty - rst2!FG
                            strStockFlag = "A"
                                    
                        Case y = 2
                            intStock = rst1!Hold
                            intDemand = rst2!MBackOrderQty - rst2!FG - rst1!Insp
                            strStockFlag = "B"
    
                        Case y = 3
                            intStock = rst1!Problem
                            intDemand = rst2!MBackOrderQty - rst2!FG - rst1!Insp - rst1!Hold
                            strStockFlag = "C"
    
                        Case y = 4
                            intStock = rst1!SCret
                            intDemand = rst2!MBackOrderQty - rst2!FG - rst1!Insp - rst1!Hold - rst1!Problem
                            strStockFlag = "D"
                    
                        Case y = 5
                            intStock = rst1!Offsite
                            intDemand = rst2!MBackOrderQty - rst2!FG - rst1!Insp - rst1!Hold - rst1!Problem - rst1!SCret
                            strStockFlag = "E"
                        
                        Case y = 6
                            intStock = rst1!SCtogo
                            intDemand = rst2!MBackOrderQty - rst2!FG - rst1!Insp - rst1!Hold - rst1!Problem - rst1!SCret - rst1!Offsite
                            strStockFlag = "F"
                        
                        Case y = 7
                            intStock = rst1!ToFettle
                            intDemand = rst2!MBackOrderQty - rst2!FG - rst1!Insp - rst1!Hold - rst1!Problem - rst1!SCret - rst1!Offsite - rst1!SCtogo
                            strStockFlag = "G"
                        
                        Case y = 8
                            intStock = rst1!Scun
                            intDemand = rst2!MBackOrderQty - rst2!FG - rst1!Insp - rst1!Hold - rst1!Problem - rst1!SCret - rst1!Offsite - rst1!SCtogo - rst1!ToFettle
                            strStockFlag = "H"
                        
                        End Select
                    Debug.Print "loop number y= " & y; " Demand =" & intDemand & " Stock=" & intStock & " Flag=" & strStockFlag
                    intSelDemFlag = 0
                    
                    
                    Do While Not rst2.EOF
                    
                    rst2.Edit
                        If intSelDemFlag > 0 Then    'decides if the intDemand formula should take into account remaining stock
                    
                            Select Case AssignDemand
            
                                Case y = 1
                                intDemand = rst2!MBackOrderQty - rst2!FG
                                
                                                          
                                Case y = 2
                                intDemand = rst2!MBackOrderQty - rst2!FG - rst1!Insp
                           
                                Case y = 3
                                intDemand = rst2!MBackOrderQty - rst2!FG - rst1!Insp - rst1!Hold
                            
                                Case y = 4
                                intDemand = rst2!MBackOrderQty - rst2!FG - rst1!Insp - rst1!Hold - rst1!Problem
                                            
                                Case y = 5
                                intDemand = rst2!MBackOrderQty - rst2!FG - rst1!Insp - rst1!Hold - rst1!Problem - rst1!SCret
                                                
                                Case y = 6
                                intDemand = rst2!MBackOrderQty - rst2!FG - rst1!Insp - rst1!Hold - rst1!Problem - rst1!SCret - rst1!Offsite
                                                
                                Case y = 7
                                intDemand = rst2!MBackOrderQty - rst2!FG - rst1!Insp - rst1!Hold - rst1!Problem - rst1!SCret - rst1!Offsite - rst1!SCtogo
                                                
                                Case y = 8
                                intDemand = rst2!MBackOrderQty - rst2!FG - rst1!Insp - rst1!Hold - rst1!Problem - rst1!SCret - rst1!Offsite - rst1!SCtogo - rst1!ToFettle
                                End Select
                        End If
                    
                        
                        If intDemand > intStock Then
                            If y = 1 Then rst2!Insp = intStock
                            If y = 2 Then rst2!Hold = intStock
                            If y = 3 Then rst2!Problem = intStock
                            If y = 4 Then rst2!SCret = intStock
                            If y = 5 Then rst2!Offsite = intStock
                            If y = 6 Then rst2!SCtogo = intStock
                            If y = 7 Then rst2!Raw = intStock
                            If y = 8 Then rst2!Scun = intStock
                            y = 8 ' Set y to move onto next stock level
                            rst2.MoveLast
                            Exit Do
                            
                            
                        End If
                        
                        If intDemand <= intStock Then
                            If y = 1 Then rst2!Insp = intDemand
                            If y = 2 Then rst2!Hold = intDemand
                            If y = 3 Then rst2!Problem = intDemand
                            If y = 4 Then rst2!SCret = intDemand
                            If y = 5 Then rst2!Offsite = intDemand
                            If y = 6 Then rst2!SCtogo = intDemand
                            If y = 7 Then rst2!Raw = intDemand
                            If y = 8 Then rst2!Scun = intDemand
                            rst2!StockFlag = strStockFlag
                            intStock = intStock - intDemand
                            rst2.MoveNext
                        End If
                        'rst2.Update
                        
                        Debug.Print "loop number=" & y; " Demand =" & intDemand & "Remaining Stock=" & intStock & " Flag=" & strStockFlag
                        Debug.Print "CaStockCode " & rst2!Component & " Date " & rst2!MLineShipDate & " Qty " & rst2!MBackOrderQty & "FG= " & rst2!FG & " Problem=" & rst2!Problem & " Hold= " & rst2!Hold & " Insp= " & rst2!Insp & " Scret=" & rst2!SCret & "Offsite= " & rst2!Offsite & " Sctogo =" & rst2!SCtogo & " Raw= " & rst2!Raw & " Scun =" & rst2!Scun & "StockFlag =" & rst2!StockFlag
                        intSelDemFlag = intSelDemFlag + 1
                    
                        
                    
                    Loop
                    
                
                    
                Next y
        intRecNo = intRecNo + 1
        Debug.Print "outside loops"
        rst.MoveNext
        Wend
                    
    
    
    
    
    
    
    Debug.Print "End routine"
    
Exit_Command88_Click:
    Exit Sub

Err_Command88_Click:
    MsgBox Err.Description
    Resume Exit_Command88_Click

A person new to crystal with very little training a part from Access based

Regards
Ian

 

[Andrzejek]

Some didly stuff...
be consistent in your naming:

    Dim [red]dbl[/red]Scrap As Double
    Dim st[red]r[/red]DocName As String
    Dim strTxt As String
    Dim dbmsg As DAO.Database
    Dim [red]rst[/red]Msgrst As DAO.Recordset

consider continuation of your strings:

strSql = "SELECT dbo_CHCIW_AllStock.Stockcode, " & _
    " dbo_CHCIW_AllStock.FinishedQty, " & _
    " dbo_CHCIW_AllStock.Comp " & _
    " FROM dbo_CHCIW_AllStock " & _
    " where (((dbo_CHCIW_AllStock.FinishedQty)>0)) " & _
    " or ((dbo_CHCIW_AllStock.Comp)>0) " & _
    " order by dbo_CHCIW_AllStock.Stockcode "

For longer strings, or even some If statements, you can do:

strSql = "SELECT dbo_CHCIW_AllStock.Stockcode, " & _
    " dbo_CHCIW_AllStock.FinishedQty, " & _
    " dbo_CHCIW_AllStock.Comp " & _
    " FROM dbo_CHCIW_AllStock "

If Something Then
    strSql = strSql & " Where (dbo_CHCIW_AllStock.Stockcode = '" & RTrim(rst!StockCode) & "')"
Else
    strSql = strSql & " Where Somthing Else"
End If

Debug.Print "2e-"; strSql
Set rst1 = db.OpenRecordset(strSql, dbOpenDynaset)

Consider:

If rst2.BOF <> rst2.EOF Then [green]
    'We have soem records here[/green]
    rst2.MoveFirst
    rst2.MoveLast
    strTxt = "2h-The number order lines are " & rst2.RecordCount & " to review" 
    intRec = rst2.RecordCount
Else     [green]'No records[/green]
    strTxt = "2h-There are no order lines to review - no records in rst2 "
End If
Debug.Print strTxt

Indent your code - it is easy to see where your structures begin and end:

With SomObject
    For i = 0 To (intRec)
        If Something or Other Then
            Do this
        Else
            Do somthing else
        End If
        Select Case y
            Case 1
                Do this
            Case 2
                Do that
            Case 3
                ....
        End Select[green]
        'i = i + 1 <- do NOT do this[/green]
    Next i
End With

Avoid 2 separate, mutually exclusive If statement:

If intDemand > intStock Then
    do this
End If

If intDemand <= intStock Then
    Do that
End If

Consider:

If intDemand > intStock Then
    do this[red]
Else[/red]
    Do that
End If

Above is the same logic, just simpler.

I would also cut some logic out of your _Click event (like your Select statements) and use separate Function:

Private Function AssignDemand(YValue As Integer) as Integer
Dim r as Integer

Select Case y
    Case 1
        r = rst2!MBackOrderQty - rst2!FG
    Case 2
        r = rst2!MBackOrderQty - rst2!FG - rst1!Insp
    ....
End Select

AssignDemand = r

End Function

But for this to work you need to declare rst2 as module variable.

Have fun.

---- Andy