-
Oct 23rd, 2017, 04:59 AM
#1
Thread Starter
Lively Member
[RESOLVED] Slow
I made a program that the user can enter an item per row, however if the row is already 15 rows above the system is already hanging/lagging/freezing the user needs to wait a minute to process the additional item.
I don't know what's wrong with my program.
I'm using Vsflexgrid, do you think because of the control that I'm using?
Code:
Private Sub stogrid_AfterEdit(ByVal Row As Long, ByVal Col As Long)
On Error GoTo X
Call SearchUOM(checkStringValue(UnQuote(stogrid.Cell(flexcpText, stogrid.Row, 1))), UnQuote(stogrid.Cell(flexcpText, stogrid.Row, 3)), stogrid.Row)
If stogrid.Row = stogrid.Rows - 1 And stogrid.TextMatrix(stogrid.Row, 3) <> "" Then
End If
Dim issuedby As String
If checkFG(stogrid.TextMatrix(stogrid.Row, 1), stogrid, stogrid.Row) = True Then
MsgBox "FG is already in list!", vbCritical, "Double Entry is not allowed"
stogrid.Cell(flexcpText, Row, 1) = ""
stogrid.Select stogrid.Row, 1
Exit Sub
End If
If stogrid.Cell(flexcpText, Row, 1) = "" Then
stogrid.Select stogrid.Row, 1
Else
Call SearchFG(checkStringValue(UnQuote(stogrid.Cell(flexcpText, Row, 1))), stogrid.Row)
End If
If stogrid.Row = stogrid.Rows - 1 And stogrid.TextMatrix(stogrid.Row, 1) <> "" Then
stogrid.Select stogrid.Row, 4
End If
If stogrid.Row >= 1 And stogrid.Col = 4 And stogrid.TextMatrix(stogrid.Row, 4) <> "" Then
For i = 1 To stogrid.Rows - 1
If Trim(checkinventory(stogrid, issuedby)) <> Empty Then
itm = Split(checkinventory(stogrid, issuedby), "-")
MsgBox "Cannot transfer item: " & stogrid.TextMatrix(itm(0), 4) & " because it has less inventory", vbCritical, "Less Inventory"
stogrid.Cell(flexcpText, itm(0), 4) = stogrid.TextMatrix(itm(0), 5)
stogrid.Select itm(0), 4, itm(0), 4
stogrid.EditCell
Exit Sub
End If
Next
'End If
End If
'End If
Dim rs As New ADODB.Recordset
Dim Y As Boolean
If rs.State = 1 Then rs.Close
rs.CursorLocation = adUseClient
If stogrid.TextMatrix(stogrid.Row, 4) <> "" And stogrid.TextMatrix(stogrid.Row, 8) <> "" Then
With stogrid
.Cell(flexcpText, .Row, 9) = stogrid.TextMatrix(.Row, 7) * stogrid.TextMatrix(.Row, 8)
.Cell(flexcpText, Row, 9) = Format(.TextMatrix(Row, 9), "###,###,###.#0")
rs.Open "SELECT Vatable FROM tbl_ItemMasterfile where ITEMCODE ='" & .TextMatrix(Row, 1) & "'", cn, 1, 3
If rs.RecordCount > 0 Then
Y = rs!Vatable
If Y = True Then
.Cell(flexcpText, .Row, 10) = Format(.Cell(flexcpText, .Row, 9) / 1.12, "###,###,###.#0")
Else
.Cell(flexcpText, .Row, 10) = .Cell(flexcpText, .Row, 9)
End If
End If
Call ComputeSalesTotal
End With
stogrid.Select stogrid.Row, 4
Exit Sub
'End If
End If
X:
End Sub
Code:
Private Sub stogrid_BeforeEdit(ByVal Row As Long, ByVal Col As Long, Cancel As Boolean)
With stogrid
If Col = 3 Then
.ColComboList(3) = AllUom(UnQuote(stogrid.Cell(flexcpText, Row, 1)))
End If
End With
End Sub
Code:
Private Sub stogrid_CellChanged(ByVal Row As Long, ByVal Col As Long)
On Error GoTo X:
Dim ti As String
Dim um As String
With stogrid
If Col = 3 Or Col = 4 Then
Dim COST As Double
If Trim(.TextMatrix(Row, 6)) <> Empty Then
'pag hindi same ng uom
If UCase(.TextMatrix(Row, 3)) = UCase(.TextMatrix(Row, 6)) Then
If Trim(.TextMatrix(Row, 4)) <> "" Then
.TextMatrix(Row, 7) = CDbl(.TextMatrix(Row, 4))
Else
.TextMatrix(Row, 7) = Trim(.TextMatrix(Row, 4))
End If
Call SearchFG6(checkStringValue(UnQuote(stogrid.Cell(flexcpText, Row, 1))), stogrid.Row)
Else
If Trim(.TextMatrix(Row, 4)) <> Empty Then
If IsNumeric(.TextMatrix(Row, 4)) = True Then
Call SearchFG5(checkStringValue(UnQuote(stogrid.Cell(flexcpText, Row, 1))), stogrid.Row)
If valuom > 0# Then
Call GetValueUOM1(checkStringValue(UnQuote(stogrid.Cell(flexcpText, Row, 6))), stogrid.Row)
If StandardUOM > 0# Then
End If
Call GetValueUOM2(checkStringValue(UnQuote(stogrid.Cell(flexcpText, Row, 3))), stogrid.Row)
If StandardUOM2 > 0# Then
End If
.Cell(flexcpText, Row, 7) = CDbl(((StandardUOM) / (StandardUOM2))) * CDbl(.TextMatrix(Row, 4))
.Cell(flexcpText, Row, 7) = Format(.TextMatrix(Row, 7), "###,###,###.##########0")
Else
End If
Else
End If
Else
.Cell(flexcpText, Row, 9) = 0
End If
Me.lblTotal.Caption = getTotal(stogrid)
End If
End If
End If
End With
With stogrid
If .Col = 4 Then
.Editable = flexEDKbdMouse
Else
.Editable = False
End If
End With
X:
End Sub
-
Oct 23rd, 2017, 07:07 AM
#2
Re: Slow
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.
-
Oct 23rd, 2017, 07:16 AM
#3
Re: Slow
Carmel
I'm not familiar with VSFlexGrid, but it appears to be a 3rd party alternative to MSFlexGrid
I didn't notice any loops in the code you provided, so that doesn't appear to be a source of slowness
How is the data stored?
- in a database on the user's harddrive
- on a network
- other
Gibra snuck his post in while I was composing.
He seems to be on the right track
Spoo
-
Oct 23rd, 2017, 03:02 PM
#4
Re: Slow
Carmel
BTW, are you using WINE?
If so, see this thread
Spoo
-
Oct 23rd, 2017, 05:00 PM
#5
Re: Slow
That Form is an accessibility lawsuit waiting to happen.
-
Oct 23rd, 2017, 08:39 PM
#6
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
-
Oct 23rd, 2017, 08:40 PM
#7
Thread Starter
Lively Member
Re: Slow
Originally Posted by Spooman
Carmel
I'm not familiar with VSFlexGrid, but it appears to be a 3rd party alternative to MSFlexGrid
I didn't notice any loops in the code you provided, so that doesn't appear to be a source of slowness
How is the data stored?
- in a database on the user's harddrive
- on a network
- other
Gibra snuck his post in while I was composing.
He seems to be on the right track
Spoo
Hi , the database stored in a local computer only.
-
Oct 23rd, 2017, 08:41 PM
#8
Thread Starter
Lively Member
Re: Slow
Originally Posted by Spooman
actually i dont know what WINE is hehhehe
-
Oct 23rd, 2017, 09:03 PM
#9
Thread Starter
Lively Member
Re: Slow
Code:
If stogrid.Row >= 1 And stogrid.Col = 4 And stogrid.TextMatrix(stogrid.Row, 4) <> "" Then
For i = 1 To stogrid.Rows - 1
If Trim(checkinventory(stogrid, issuedby)) <> Empty Then
itm = Split(checkinventory(stogrid, issuedby), "-")
MsgBox "Cannot transfer item: " & stogrid.TextMatrix(itm(0), 4) & " because it has less inventory", vbCritical, "Less Inventory"
stogrid.Cell(flexcpText, itm(0), 4) = stogrid.TextMatrix(itm(0), 5)
stogrid.Select itm(0), 4, itm(0), 4
stogrid.EditCell
Exit Sub
End If
Next
End If
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
This code slowdown my system. Because I tried to remove it and the system works smoothly.
What I need to do , because I need this 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
|