slow filtering on table

niall91

New Member
Joined
Jul 21, 2020
Messages
44
Office Version
  1. 2019
Platform
  1. Windows
Hi,

When i import data from an access database to an excel file and create a table I'm having an issue with extremely slow filtering of that table afterwards.
Table is around 3000 rows
I have larger tables on other excel files that are not imported from a database and these filter instantly.
Attached is the sub
Any ideas?

VBA Code:
Dim fld As Field
Dim cnt As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sh As Worksheet: Set sh = ThisWorkbook.Sheets("Sheet1")
Dim rngTable As Range
Dim headers As Range
Dim list As String, Addr As String
Dim C As Integer
Dim R As Long

'delete table first
sh.Range("A11").CurrentRegion.Delete

Set cnt = New ADODB.Connection
Set rs = New ADODB.Recordset

'connect using database string
    cnt.ConnectionString = _
    "Provider=Microsoft.ACE.OLEDB.12.0;Data " & _
    "Source=S:\Fly M.E.S Software\Databases\Order Book Database.accdb;Persist " & _
    "Security Info=False;"

'open the connection
    cnt.Open
'set record set with connection

    With rs
        .ActiveConnection = cnt
        .Source = "select * from Orders"
        .LockType = adLockOptimistic
        .CursorType = adOpenForwardOnly
        .Open
    End With

'set error handler
    On Error GoTo Finish
'loop through record set

    X = 1
    For Each fld In rs.Fields
      sh.Cells(10, X) = fld.Name
      sh.Columns(X).EntireColumn.AutoFit
      X = X + 1 'tick iterator
    Next
    
    Set headers = Sheet1.Range("A10").CurrentRegion
        
'insert data
    Range("A11").CopyFromRecordset rs
    
    Set rngTable = Sheet1.Range("A10").CurrentRegion
    R = rngTable.Rows.Count
    
    rngTable.Interior.Pattern = xlNone
'set table
    sh.ListObjects.Add(xlSrcRange, rngTable).Name = "Orders"
    sh.ListObjects("Orders").TableStyle = "TableStyleMedium14"

'Formating   
    C = findHeaders("Dispatch", headers)
    sh.Range(sh.Cells(11, C), sh.Cells(R + 9, C)).FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""Waiting"""
        rngTable.FormatConditions(1).Interior.Color = RGB(255, 235, 156)
    
    rngTable.FormatConditions.Add Type:=2, Operator:=xlEqual, Formula1:="=$M10=""Finished"""
        rngTable.FormatConditions(2).Interior.Color = RGB(163, 233, 255)
    
    rngTable.FormatConditions.Add Type:=2, Operator:=xlEqual, Formula1:="=$M10=""Cancelled"""
        rngTable.FormatConditions(3).Interior.Color = RGB(231, 230, 230)

'adjusting columns
    sh.Columns(findHeaders("Surf Code", headers)).ColumnWidth = 8
    sh.Columns(findHeaders("Customer Name", headers)).ColumnWidth = 40
    sh.Columns(findHeaders("Customer Reference", headers)).ColumnWidth = 35
    sh.Columns(findHeaders("Customer Reference", headers)).HorizontalAlignment = xlHAlignCenter
    sh.Columns(findHeaders("Finish", headers)).ColumnWidth = 15
    sh.Columns(findHeaders("Description", headers)).ColumnWidth = 30
    sh.Columns(findHeaders("Description", headers)).HorizontalAlignment = xlHAlignCenter

'unlock table
    sh.ListObjects("Orders").Range.Locked = False

'hide columns
    sh.Columns(findHeaders("ID", headers)).Hidden = True
    sh.Columns(findHeaders("Woodparts Reference", headers)).Hidden = True
    sh.Columns(findHeaders("Customer Sub Reference", headers)).Hidden = True
    sh.Columns(findHeaders("Product Category", headers)).Hidden = True

'add data validation
    list = "Finished,In Production,Cancelled"
    
    C = findHeaders("Order Status", headers)

    With sh.Range(sh.Cells(11, C), sh.Cells(R + 9, C)).Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=list
        .InCellDropdown = True
    End With
    
    C = findHeaders("Dispatch", headers)

    list = "Waiting,Dispatched"
    
    With sh.Range(sh.Cells(11, C), sh.Cells(R + 9, C)).Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=list
        .InCellDropdown = True
    End With

Finish:
'close the connection
    rs.Close
'close the connection
    cnt.Close
 
    Set cnt = Nothing
    Set rs = Nothing

sh.Protect

End Sub
 

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.

niall91

New Member
Joined
Jul 21, 2020
Messages
44
Office Version
  1. 2019
Platform
  1. Windows
Update:
So when i save and close the workbook and reopen it the filters work perfect (really fast).
Is there a way i can do this without have to close the workbook?
 
Upvote 0

VincentCops

New Member
Joined
Jul 13, 2022
Messages
1
Office Version
  1. 365
Platform
  1. Windows
Hello Niall,
I have similar problems with slow filtering in a table (100cols x 2000 rows).
The calculation is fast enough when changing data. But simple filtering (on value "true" in a calculated column with just boolean values) takes a long time.
Have you found a reason/solution for your problem ?
 
Upvote 0

Forum statistics

Threads
1,187,138
Messages
5,961,766
Members
438,563
Latest member
Ron Gluck

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
Top