|
-
Oct 23rd, 2017, 08:39 PM
#3
Thread Starter
Lively Member
Re: Slow
 Originally Posted by gibra
No, VSFelxGrid is a good control.
You are using severl functions (I.e. on stogrid_AfterEdit):
- SearchUOM
- UnQuote
- checkFG
- SearchFG
- checkinventory
- ComputeSalesTotal
and a cicle that, of course, increases the time it takes for each new entry and change:
- For i = 1 To stogrid.Rows - 1
So I suspect that the cause of the slowdown may be caused by these.
But this functions are missing in your code, so we don't know what does.

Oh I'm sorry ,
here's the code for that function
Code:
Function SearchUOM(strS As String, UOMStr As String, Row As Long)
Call con
If rs.State = 1 Then rs.Close
rs.CursorLocation = adUseClient
If stogrid.Rows - 1 <= 150 Then
rs.Open "select * from View_item_uom2 where itemcode like '" & strS & "' AND UOM='" & UOMStr & "' order by cost DESC", cn, 1, 3
If rs.RecordCount <> 0 Then
With stogrid
.TextMatrix(stogrid.Row, 3) = rs.Fields(2).Value
.Cell(flexcpText, Row, 8) = Format(.TextMatrix(Row, 8), "###,###,###.#0")
End With
End If
End If
Call ComputeSalesTotal
End Function
Function SearchUOMweighted(strS As String, UOMStr As String, Row As Long)
Call con
If rs.State = 1 Then rs.Close
rs.CursorLocation = adUseClient
If stoweighted.Rows - 1 <= 150 Then
rs.Open "select * from View_item_uom2 where itemcode like '" & strS & "' AND UOM='" & UOMStr & "' order by cost desc", cn, 1, 3
If rs.RecordCount <> 0 Then
With stoweighted
.TextMatrix(stoweighted.Row, 3) = rs.Fields(2).Value
End With
End If
End If
Call ComputeSalesTotalWeighted
End Function
Code:
Public Function UnQuote(strText As String) As String
Dim strNewWord As String
Dim strApostrophe As String
Dim intCounter As Integer
strNewWord = ""
For intCounter = 1 To Len(strText)
strApostrophe = Mid(strText, intCounter, 1)
If strApostrophe = Chr(34) Or strApostrophe = "'" Then strApostrophe = strApostrophe + strApostrophe
strNewWord = strNewWord + strApostrophe
Next intCounter
UnQuote = strNewWord
End Function
Code:
Public Function checkFG(fcode As String, grd As VSFlexGrid, r As Integer)
Dim inlist As Boolean
Dim i As Integer
inlist = False
With grd
For i = 1 To .Rows - 1
If r <> i And .TextMatrix(i, 1) = UCase(fcode) Then
inlist = True
Exit For
End If
Next
End With
checkFG = inlist
End Function
Code:
Function SearchFG(strS As String, Row As Long)
Call con
Dim rs_fg As New ADODB.Recordset
If rs.State = 1 Then rs.Close
rs.CursorLocation = adUseClient
If stogrid.Rows - 1 <= 150 Then
rs.Open "select * from View_FG where CATEGORY='NON-WEIGHTED' AND itemcode like '" & strS & "' OR BARCODE like '" & strS & "'", cn, 1, 3
If rs.RecordCount <> 0 Then
With stogrid
.TextMatrix(stogrid.Row, 1) = rs.Fields(0).Value
.TextMatrix(stogrid.Row, 2) = rs.Fields(1).Value
If .TextMatrix(stogrid.Row, 3) = Empty Then
.TextMatrix(stogrid.Row, 3) = rs.Fields(3).Value 'uom
End If
'.TextMatrix(stogrid.Row, 5) = rs.Fields(4).Value
.TextMatrix(stogrid.Row, 5) = rs.Fields(2).Value
.TextMatrix(stogrid.Row, 6) = rs.Fields(3).Value
stogrid.Select stogrid.Row, 4
Exit Function
End With
Else
MsgBox strS & " does not Exists from Finished Goods Records...", vbInformation, "No Record"
stogrid.TextMatrix(Row, 0) = ""
stogrid.TextMatrix(Row, 1) = ""
stogrid.TextMatrix(Row, 2) = ""
stogrid.TextMatrix(Row, 3) = ""
stogrid.TextMatrix(Row, 4) = ""
stogrid.SetFocus
stogrid.Select stogrid.Rows - 1, 1
Exit Function
End If
Exit Function
End If
End Function
Code:
Function checkinventory(gd As VSFlexGrid, issuedby As String) As String
Dim LessInv As Boolean
With gd
LessInv = False
For i = 1 To .Rows - 1
If rs.State = 1 Then rs.Close
rs.CursorLocation = adUseClient
rs.Open "select * from tbl_ItemsInventory where FGID ='" & stogrid.TextMatrix(i, 1) & "'", cn, 1, 3
If rs.RecordCount <> 0 Then
Dim newcurrent As Double
Dim current As Double
current = 0#
newcurrent = 0#
current = CDbl(Round(rs!current_stock, 5))
If Trim(.TextMatrix(i, 7)) <> Empty Then
newcurrent = CDbl(.TextMatrix(i, 7))
newcurrent = CDbl(current - newcurrent)
less = CDbl(.TextMatrix(i, 7))
totalstock = CDbl(current) + CDbl(less)
Else
newcurrent = CDbl(current) - CDbl(.TextMatrix(i, 7))
less = CDbl(.TextMatrix(i, 7))
totalstock = CDbl(current) + CDbl(less)
End If
'MsgBox CDbl(current)
If CDbl(newcurrent) < 0# Then
'MsgBox "Cannot transfer item: " & .TextMatrix(i, 3) & " because it has less inventory", vbCritical, "Less Inventory"
'.Select i, 5, 1, 5
' .EditCell
LessInv = True
Exit For
End If
End If
'End If
Next
If LessInv = True Then
checkinventory = i & "-" & LessInv
Else
checkinventory = ""
End If
End With
End Function
Code:
Function ComputeSalesTotal()
On Error GoTo ErrHandler
Dim X As Integer
ComputeSalesTotal = 0
Dim NTotal, gtotal, T1 As Double
NTotal = 0
T1 = 0
gtotal = 0
For X = 1 To frmSTO.stogrid.Rows - 1
If frmSTO.stogrid.TextMatrix(X, 9) <> "" Then
ComputeSalesTotal = ComputeSalesTotal + CDbl(frmSTO.stogrid.TextMatrix(X, 9))
ComputeSalesTotal = ComputeSalesTotal + CDbl(NTotal)
End If
Next
ComputeSalesTotal = CDbl(Format(ComputeSalesTotal, "###,###,###.00"))
frmSTO.lblTotal.Caption = Format(CDbl(ComputeSalesTotal), "###,###,###.00")
ErrHandler:
sMsg = "Error #" & Err.Number & ": '" & Err.DESCRIPTION & "' from '" & Err.Source & "'"
End Function
Tags for this Thread
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|