reproduce code to make fast when populate data in listbox on userform

Mussala

Board Regular
Joined
Sep 28, 2022
Messages
88
Office Version
  1. 2019
Platform
  1. Windows
Hello
this code works with simple data and three sheets, but what I want to make it fast by make dealing with about at least 9000 rows for each sheet and increase sheet to become about 20 sheets at least.
the code will show all of data across sheets and exclude row contains OPENING word in column C and row contains TOTAL word in column A.
currently code is too slow with big data.
VBA Code:
Sub LoadData()

    Dim s$(1), x, e
    For Each e In Array("Mussala", "mssau", "mjhgsg")
        s(0) = s(0) & IIf(s(0) = "", "", "Union All (") & "Select " & _
        "Format(`DATE`,'dd/mm/yyyy'), `INVOICE NO`, `TYPE`, `DEBIT`, `CREDIT`, " & _
        "`BALANCE` From `" & e & "$` Where `TYPE` <> 'OPENING' And `TYPE` Is Not Null " & IIf(s(0) = "", "", ") ")
    Next
    s(1) = "Provider=Microsoft.Ace.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & _
         ";Extended Properties='Excel 12.0;HDR=Yes';"
    With CreateObject("ADODB.Recordset")
        .Open s(0), s(1), 3, 3, 1
        x = .GetRows
    End With
    With Me.ListBox1
        .ColumnCount = UBound(x, 1) + 1
        .Column = x
        For i = 0 To .ListCount - 1
     .List(i, 3) = Format(.List(i, 3), "#,##0.00")
     .List(i, 4) = Format(.List(i, 4), "#,##0.00")
     Next i
    End With
End Sub
I hope somebody can reproduce this code to make fast it.
 
I don't know where your code is slow. Can you try it with this amended code and post the results?

VBA Code:
Option Explicit


'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
'\\         Macro Speed Timer Functions           \\
'\\ Purpose: Measure elapsed time in milliseconds \\
'\\           based on functions from             \\
'https://www.aeternus.sg/best-millisecond-timer-vba/
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

' Performance counter API's
#If VBA7 And Win64 Then
    'for 64-bit Excel
    Declare PtrSafe Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As Currency) As Long
    Declare PtrSafe Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As Currency) As Long
#Else
    'for 32-bit Excel
    Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As Currency) As Long
    Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As Currency) As Long
#End If

    Dim curStartPerformanceCounter As Currency
    Dim curEndPerformanceCounter As Currency
    Dim curFrequency As Currency

Sub TimerStart()
    Dim lgResult As Long

    'obtain no: of counts per second
    lgResult = QueryPerformanceFrequency(curFrequency)

    'measure start count
    lgResult = QueryPerformanceCounter(curStartPerformanceCounter)
End Sub


Function TimerEnd(Optional sS As String) As String
    Dim lgResult As Long
    
    
    'measure end count
    lgResult = QueryPerformanceCounter(curEndPerformanceCounter)

    'measure elapsed time
    TimerEnd = "Elapsed time (ms): " & (curEndPerformanceCounter - curStartPerformanceCounter) / curFrequency & " - " & sS
    Debug.Print TimerEnd
End Function

'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
' Here follows your  macro with added lines to check which part _
  of the macro is slow
'///////////////////////////////////////////////////////////////

Sub LoadData()
    Dim sSpeedTest As String    '// for testing which part is slow
    
    Dim s$(1), x, e
    
    TimerStart  'start timer
'    For Each e In Array("Mussala", "mssau", "mjhgsg")
'        s(0) = s(0) & IIf(s(0) = "", "", "Union All (") & "Select " & _
'        "Format(`DATE`,'dd/mm/yyyy'), `INVOICE NO`, `TYPE`, `DEBIT`, `CREDIT`, " & _
'        "`BALANCE` From `" & e & "$` Where `TYPE` <> 'OPENING' And `TYPE` Is Not Null " & IIf(s(0) = "", "", ") ")
'    Next
    'record 1st item
    sSpeedTest = "Build SQL query : " & TimerEnd
    TimerStart
    
'    s(1) = "Provider=Microsoft.Ace.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & _
'         ";Extended Properties='Excel 12.0;HDR=Yes';"
'    With CreateObject("ADODB.Recordset")
'        .Open s(0), s(1), 3, 3, 1
'        x = .GetRows
'    End With
    
    sSpeedTest = sSpeedTest & vbCrLf & "Carry-out SQL query : " & TimerEnd
    TimerStart
    
    
'    With Me.ListBox1
'        .ColumnCount = UBound(x, 1) + 1
'        .Column = x
'        For i = 0 To .ListCount - 1
'     .List(i, 3) = Format(.List(i, 3), "#,##0.00")
'     .List(i, 4) = Format(.List(i, 4), "#,##0.00")
'     Next i
'    End With
    
    sSpeedTest = sSpeedTest & vbCrLf & "build, format listbox : " & TimerEnd
    MsgBox sSpeedTest
End Sub
 
Upvote 0
Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at: Improve code using ADODB.Recordset when populate data in listbox to make fast [SOLVED]
There is no need to repeat the link(s) provided above but if you have posted the question at other places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.
 
Upvote 0

Forum statistics

Threads
1,226,771
Messages
6,192,917
Members
453,766
Latest member
Gskier

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top