average price: multidimensional array

Please start any new threads on our new site at https://forums.sqlteam.com. We've got lots of great SQL Server experts to answer whatever question you can come up with.

All Forums

SQL Server 2000 Forums

SQL Server Development (2000)

average price: multidimensional array

Author

Topic

noblemfd
Starting Member

38 Posts

Posted - 2013-05-02 : 17:11:56

I just got a job in a company, and what they've been using is VB6 and MS SQL 2000. Am to calculate the Average Price of the Stocks, based on ItemID and Warehouse, and display it in crystal report. I've written Functions in Class Module and called it in VB Code.
The main Function is getAvgPrice and it calls other Functions as the need be. But it takes a lot of time. Please how do I convert this VB6 Function in Class Module to MSSQL 2000 Stored Procedure, and how do I write the multidimensional array in MSSQL 2000 Stored Procedure.
Please help....My boss is on my neck, he needs it very urgently

Public Function getAvgPrice(enddate As Date) As Double
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||'
'|| Get Average Price of each of the items in the stock ||||'
'|| Input: ||||'
'|| cardID -> The ID of the Item [String] ||||'
'|| QtySup -> the quantity of Item [Double] ||||'
'|| Output: ||||'
'|| The value of the stock of Items ||||'
'|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||'
' '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
On Error GoTo CheckError
Dim connectstockcard As New ADODB.Recordset
Dim itmDate As Date, begdate As Date
Dim erp As New clsERP
Dim Start As Date
Start = CDate(erp.period("start"))
Dim itmVal, ItmVal2, TotalVal, cumQty, cumVal As Double
Dim Stock_Array() As Variant
Dim Count_i, Count_J As Integer
Dim itmbal As Double
Dim Last_Error As New ClsPostError
Dim ItmBal1, ItmBal2 As Double
Dim BegBal, QtySup_Bal, BegQtyLeft As Double
Dim MyItem As String
Dim BegBalPrice As Double
Dim Price_Beg8 As Double
Dim Inv_Beg8 As String
Dim Qtyleft8 As Double
Dim QtyLeft As Double
Dim suspense_val As Double
itmVal = 0
itmbal = Val(TotalQty(enddate)) 'Get Current Stock Bal from Stockcard01-12
ItmBal1 = itmbal

Dim connectitem As New ADODB.Recordset
With connectitem
If connectitem.State <> adStateClosed Then connectitem.Close
.ActiveConnection = connecttoasl: .Source = "SELECT * FROM aslitem1 WHERE itemid2='" & cardID_ & "'": .CursorLocation = adUseClient: .CursorType = adOpenDynamic: .LockType = adLockOptimistic: .Open
End With

MyItem = getCardID
'ItmBal2 = 0: ItmBal2 = CDbl(connectitem("qtyonhand"))
BegBal = "": BegBal = CDbl(connectitem("Total_Begqty"))
QtySup_Bal = "": QtySup_Bal = CDbl(connectitem("Qty_Sup_4rm_BegBal"))
BegQtyLeft = 0: BegQtyLeft = Val(BegBal) - Val(QtySup_Bal)
suspense_val = 0: suspense_val = CDbl(connectitem("suspense_val"))

Dim connectAP As New ADODB.Recordset
With connectAP
Dim strSQL
strSQL = "SELECT Inv2,qty,rate As Price,amt as amount,Qtydelivered,Qtysupplied,date1,QtyReturned FROM aslAPinvoicedetail where ( item_id ='" & cardID_ & "') AND (" & " QtyDelivered - QtyReturned > QtySupplied " & ")" & " Order By Date1,Control1"
If connectAP.State <> adStateClosed Then connectAP.Close
.ActiveConnection = connecttoasl
.Source = strSQL
.CursorLocation = adUseClient
.CursorType = adOpenDynamic
.LockType = adLockOptimistic
.Open
End With
ReDim Stock_Array(Val(connectAP.RecordCount) + 1, 5)
For counter7 = 0 To connectAP.RecordCount
Stock_Array(counter7, 0) = ""
Stock_Array(counter7, 1) = ""
Stock_Array(counter7, 2) = ""
Stock_Array(counter7, 3) = ""
Stock_Array(counter7, 4) = ""
Next counter7
Stock_Array(Count_J, 0) = Count_J
Stock_Array(Count_J, 1) = connectitem("date1")
Stock_Array(Count_J, 2) = Val(BegQtyLeft)
Stock_Array(Count_J, 3) = "BEGBAL"
Stock_Array(Count_J, 4) = Val(BegBalPrice)
For Count_J = 1 To connectAP.RecordCount
Stock_Array(Count_J, 0) = Count_J
Stock_Array(Count_J, 1) = connectAP("date1")
Stock_Array(Count_J, 2) = Val(connectAP("QtyDelivered")) - Val(connectAP("QtySupplied"))
Stock_Array(Count_J, 3) = connectAP("Inv2")
Stock_Array(Count_J, 4) = connectAP("Price")
Next Count_J

Count_i = 0
Do While Val(cumQty) <= Val(ItmBal1)
cumQty = Val(cumQty) + (Stock_Array(Count_i, 2))
If Val(cumQty) <= Val(ItmBal1) Then
itmVal = Stock_Array(Count_i, 2) * Val(Stock_Array(Count_i, 4)) + itmVal
Else
ItmVal2 = Val(ItmBal1) - (cumQty - Stock_Array(Count_i, 2))
itmVal = (ItmVal2 * Val(Stock_Array(Count_i, 4))) + itmVal
Exit Do
End If
If Count_i = Count_J - 1 Then Exit Do

Count_i = Count_i + 1
Loop
getAvgPrice = 0
If Val(ItmBal1) <> 0 Then
getAvgPrice = Val(itmVal) / Val(ItmBal1)
End If

If connectAP.State <> adStateClosed Then connectAP.Close
Set connectAP = Nothing
If connectitem.State <> adStateClosed Then connectitem.Close
Set connectitem = Nothing
Exit Function
CheckError:

MsgBox err.Description

End Function

Public Function getCardID() As String
Dim ConnectAccount As New ADODB.Recordset
With ConnectAccount
strSQL = "SELECT itemid2 AS itemID " _
& " FROM aslitem1" _
& " WHERE (aslitem1.itemid2='" & cardID_ & "')"

.ActiveConnection = connecttoasl
.Source = strSQL
.CursorLocation = adUseClient
.CursorType = adOpenDynamic
.LockType = adLockOptimistic
.Open
End With
If ConnectAccount.RecordCount > 0 Then
getCardID = ConnectAccount("itemID")
Else
getCardID = "ID do not exist"
End If
End Function

Public Function getCardFirstPrice(cardID_ As String) As Double
Dim transbegin As Integer
'Get 1st Price in Begbal Price(aslprice1 or aslprice2 as the case may be)
mySQL = "": mySQL = "SELECT * FROM aslprice2 WHERE itemid2 ='" & Trim(cardID_) & "'" & " Order By Control1"
Dim connecttoasl211 As New ADODB.Recordset
With connecttoasl211
.ActiveConnection = connecttoasl
If .State <> adStateClosed Then .Close
.Source = mySQL
.CursorLocation = adUseClient
.CursorType = adOpenDynamic
.LockType = adLockOptimistic
.Open
End With
If connecttoasl211.RecordCount > 0 Then
connecttoasl211.MoveFirst
getCardFirstPrice = CDbl(Trim(connecttoasl211("Cost")))
Else
mySQL = "": mySQL = "SELECT * FROM aslprice WHERE itemid2 ='" & Trim(cardID_) & "'"
Set connecttoasl211 = New ADODB.Recordset
With connecttoasl211
.ActiveConnection = connecttoasl
If .State <> adStateClosed Then .Close
.Source = mySQL
.CursorLocation = adUseClient
.CursorType = adOpenDynamic
.LockType = adLockOptimistic
.Open
End With
If connecttoasl211.RecordCount = 1 Then
getCardFirstPrice = CDbl(Trim(connecttoasl211("Cost")))
End If
End If
End Function

Public Function FwdBal(enddate As Date) As Double
Dim connectstockcard As New ADODB.Recordset
Dim erp As New clsERP
Dim Start As Date
Start = CDate(erp.period("start"))
If Format(enddate, "dd/mm/yyyy") < Format(Start, "dd/mm/yyyy") Then
'FwdBal = Val(BegBal)
FwdBal = 0
Exit Function
End If
'We need to format the date to the ANSI standard since SQL is an ANSI standard == US standard
Dim d1 As String
d1 = USDateStyle(CDate(enddate))

strSQL = "SELECT SUM(CAST(QtyIN as float) - CAST(QtyOUT as float)) AS Balance,count(ItemID) as total" _
& " From vwAStockCardBalance" _
& " Where ItemID='" & ID_ & "' AND (Warehouse = '" & WH_ & "') AND TDate < '" & d1 & "'"
With connectstockcard
If .State <> adStateClosed Then .Close
.ActiveConnection = connecttoasl
.Source = strSQL
.CursorLocation = adUseClient
.CursorType = adOpenDynamic
.LockType = adLockOptimistic
.Open
End With
Dim Bal As Double
If IsNull(connectstockcard("Balance")) = True Then
FwdBal = 0
Else
FwdBal = connectstockcard("Balance")
End If
connectstockcard.Close
Set connectstockcard = Nothing

End Function

James K
Master Smack Fu Yak Hacker

3873 Posts

Posted - 2013-05-02 : 18:03:53

It is very hard for anyone to read through the code you posted and make suggestions, especially since they don't know the data model. So what I am going to say is not a solution to your problem; rather it is an approach that you can take to solve the problem.

First, I would suggest to do it in scratch in SQL rather than trying to convert the VB code. There are couple of reasons for it: a) In SQL you would do set-based queries - not loops and b) There is no two-dimensional array in a database in the conventional sense that you think about it. You can represent two-dimensional arrays, but they would simply be tables.

Second, take a small sample set - for example, one ticker for 3 days or so and figure out how you would calculate the average in SQL. Post the code and the table schema along with the sample data. If you need help in posting, take a look at this blog: http://weblogs.sqlteam.com/brettk/archive/2005/05/25/5276.aspx

With that much information, people on the forum should be able to suggest efficient solutions for your problem.

noblemfd
Starting Member

38 Posts

Posted - 2013-05-02 : 23:01:47

Alright, but how do I do this in MSSQL 2000

Dim Stock_Array() As Variant

ReDim Stock_Array(Val(connectAP.RecordCount) + 1, 5)
For counter7 = 0 To connectAP.RecordCount
Stock_Array(counter7, 0) = ""
Stock_Array(counter7, 1) = ""
Stock_Array(counter7, 2) = ""
Stock_Array(counter7, 3) = ""
Stock_Array(counter7, 4) = ""
Next counter7
Stock_Array(Count_J, 0) = Count_J
Stock_Array(Count_J, 1) = connectitem("date1")
Stock_Array(Count_J, 2) = Val(BegQtyLeft)
Stock_Array(Count_J, 3) = "BEGBAL"
Stock_Array(Count_J, 4) = Val(BegBalPrice)
For Count_J = 1 To connectAP.RecordCount
Stock_Array(Count_J, 0) = Count_J
Stock_Array(Count_J, 1) = connectAP("date1")
Stock_Array(Count_J, 2) = Val(connectAP("QtyDelivered")) - Val(connectAP("QtySupplied"))
Stock_Array(Count_J, 3) = connectAP("Inv2")
Stock_Array(Count_J, 4) = connectAP("Price")
Next Count_J

Count_i = 0
Do While Val(cumQty) <= Val(ItmBal1)
cumQty = Val(cumQty) + (Stock_Array(Count_i, 2))
If Val(cumQty) <= Val(ItmBal1) Then
itmVal = Stock_Array(Count_i, 2) * Val(Stock_Array(Count_i, 4)) + itmVal
Else
ItmVal2 = Val(ItmBal1) - (cumQty - Stock_Array(Count_i, 2))
itmVal = (ItmVal2 * Val(Stock_Array(Count_i, 4))) + itmVal
Exit Do
End If
If Count_i = Count_J - 1 Then Exit Do

Count_i = Count_i + 1
Loop
getAvgPrice = 0
If Val(ItmBal1) <> 0 Then
getAvgPrice = Val(itmVal) / Val(ItmBal1)
End If

Subscribe to SQLTeam.com

SQLTeam.com Articles via RSS

SQLTeam.com Weblog via RSS

- Advertisement -

Resources