sped up fill listview

[luca90]

I have in rset 15.878 lines of rset.
But i see to fill the listview the time is very long...
Is possible to speed up code???

Sub FILL_LISTVIEW_2()
'SI
    Dim TOT As Double, TOT1 As Double, CONTA_RECORD As Long, TOT2 As Double
    Dim X

    On Error GoTo errore

    CONTA_REC = Empty

    strSQL1 = "SELECT * FROM DATI WHERE PROVA16 = '" & Left(Me.COMBO_AREA.Text, 4) & "' ORDER BY PROVA2"
    Set RSSQLD = CNSQL.Execute(strSQL1)

    While Not RSSQLD.EOF
        CONTA_REC = CONTA_REC + 1
        RSSQLD.MoveNext
    Wend
    
    RIGA = Empty

    Me.ProgressBar.Visible = True
    Me.ProgressBar.value = Empty

    Me.ListView.ListItems.Clear

    With RSSQLD

        Me.ListView.Refresh

        RSSQLD.MoveFirst
        While Not .EOF

            Set X = ListView.ListItems.Add(, , RSSQLD.GetRows!PROVA2)
            X.SubItems(1) = .Fields!PROVA1
            X.SubItems(2) = .Fields!PROVA3
            X.SubItems(3) = .Fields!PROVA9
            X.SubItems(4) = .Fields!PROVA11
            X.SubItems(5) = .Fields!PROVA12

            If IsNull(.Fields!PROVA17) Then
                X.SubItems(6) = Format(0, "#,##0.00")
                'Debug.Print .Fields!PROVA17
            Else
                X.SubItems(6) = Format(.Fields!PROVA17, "#,##0.00")
                TOT = TOT + X.SubItems(6)
            End If

            If IsNull(.Fields!PROVA13) Then
                X.SubItems(7) = Format(0, "#,##0.00")
            Else
                X.SubItems(7) = Format(.Fields!PROVA13, "#,##0.00")
                TOT1 = TOT1 + X.SubItems(7)
            End If

            If IsNull(.Fields!PROVA14) Then
                X.SubItems(8) = Format(0, "#,##0.00")
                'Debug.Print .Fields!PROVA14
            Else
                X.SubItems(8) = Format(.Fields!PROVA14, "#,##0.00")
                TOT2 = TOT2 + X.SubItems(8)
            End If

            If Not IsNull(.Fields!PROVA18) Then
                X.SubItems(9) = Format(.Fields!PROVA18, "#,##0")
            Else
                X.SubItems(9) = Format(0, "#,##0")
            End If

            RIGA = RIGA + 1

            .MoveNext

            'DoEvents
            Me.ProgressBar.value = (RIGA / CONTA_REC) * 100

        Wend

        Me.ProgressBar.Visible = False

    End With

    Me.Label4.Caption = Format(TOT1, "#,##0.00")
    Me.Label9.Caption = Format(TOT, "#,##0.00")
    Me.Label14.Caption = Format(TOT2, "#,##0.00")
    Me.Label6.Caption = Format(ListView.ListItems.Count, "#,##0")

    Exit Sub

errore:
    MsgBox "Errore Numero: " & CStr(Err.Number) & vbCrLf & _
           "Descrizione: " & Err.Description & vbCrLf & _
           "Sorgente dell'Errore: " & Err.Source

    Err.Clear

End Sub

[Hack]

My immediate reaction would be to filter the query and not add 15,000 plus records to the listview in the first place.

No one is going to want to wade through that many records to find what they want.

[Siddharth Rout]

There are many things that you can do...

1) Transfer data into an array first and then load it in a listview
or
2) Try not using a progress bar here as it slows the process here...
or
3) The best suggestion that I can give you in this case is to use a flexgrid instead of listview....

[RobDog888]

Two other ways,

1. Use LockWindowUpdate API and then load. After loaded unlock it.

2. Hide the Listview, load it, when done reshow it.

[luca90]

Two other ways,

1. Use LockWindowUpdate API and then load. After loaded unlock it.

2. Hide the Listview, load it, when done reshow it.

hI my friend about the piont 1. not sure i have never used in my project... have alink to learn or an example

....Use LockWindowUpdate API and then load. After loaded unlock it.


for the array system is thsi a good code????:

'Option Explicit
Dim CNSQLST As New Connection
Private Sub Command1_Click()

    Dim cnn As ADODB.Connection
    Dim rs2 As ADODB.Recordset
    Dim myarr As Variant
    Dim i As Integer
    Dim strSQL As String
    Set cnn = New ADODB.Connection
    Call APRI_CONNESSIONI_SQLST
    test = "8505"
    Set rs2 = New ADODB.Recordset
    strSQL = "SELECT PROVA2,PROVA1,PROVA3,PROVA9,PROVA11,PROVA12,PROVA17,PROVA13,PROVA14,PROVA18 FROM DATI WHERE PROVA16 = '" & test & "' ORDER BY PROVA2"
    rs2.Open strSQL, CNSQLST, adOpenStatic, adLockOptimistic
    
    If Not rs2.EOF Then
        myarr = rs2.GetRows
        For i = LBound(myarr, 2) To UBound(myarr, 2)
           test = myarr(0, i)
            test = myarr(2, i)
            test = myarr(3, i)
            test = myarr(4, i)
            test = myarr(5, i)
            test = myarr(6, i)
            test = myarr(7, i)
            test = myarr(8, i)
            test = myarr(9, i)
        Next
    End If
    
    rs2.Close
    Set rs2 = Nothing
    CNSQLST.Close
    Set CNSQLST = Nothing
    
End Sub
Sub APRI_CONNESSIONI_SQLST()

    On Error GoTo errore
    'TABLENAME = "MERCATI"
    'CONTA_REC = Empty
    '\\\\\\\\\\\\\\\\\
    'CNSQLST.CursorLocation = adUseServer
    'CNSQLST.CommandTimeout = 120
    'CNSQLST.Open "Provider=SQLOLEDB.1;Password=sal21;Persist Security Info=True;User ID=sa;Initial Catalog=DB_PAST_DUE;Data Source=10.232.185.108\SQLEXPRESS"
    '\\\\\\\\\\\\\\\\\\

    CNSQLST.CursorLocation = adUseClient
    CNSQLST.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                 "Data Source=C:\APPLICAZIONI\DB_PAST_DUE.mdb;"

    'SQL = "TRUNCATE TABLE MERCATI"

    'RSDST.Open "SELECT COD_5,COD_AG FROM STAFF", CNSQLST, adOpenKeyset, adLockReadOnly
    Exit Sub

errore:
    MsgBox "Errore Numero: " & CStr(Err.Number) & vbCrLf & _
           "Descrizione: " & Err.Description & vbCrLf & _
           "Sorgente dell'Errore: " & Err.Source

    Err.Clear

End Sub

[Hack]

This is what RobDog888 is referring to

Public Declare Function LockWindowUpdate Lib "user32"  (ByVal hWnd As Long) As Long

Public Sub LockWindow(lHandle As Long)
    LockWindowUpdate lHandle
End Sub

Public Sub UnlockWindow()
    LockWindowUpdate 0
End Sub

Private Sub cmdUpdate_Click()
LockWindow(Form1.hWnd)
'Load your listview here
UnlockWindow
End Sub

[RobDog888]

I added [code] tags to your post to make it easier to read.

You shouldnt comment out Option Explicit. It should always be on.