Excel VBA loop slow

S

shakaib26

New Member
Joined
Feb 3, 2023
Messages
19
Office Version
  1. 365
Platform
  1. Windows
Hi everyone,

i have 80000 rows in "c"column with date in it. i am running below mentioned code to add the combobox list items on combobox change basis. When i run the macro it takes too long time on each change.

Can anybody suggest what to do to speed up the code.


Private Sub ComboBox2_Change()
Dim ws As Worksheet
Set ws = Worksheets("word by word")
Dim Lastrow, r, i As Long

For i = ComboBox2.ListCount - 1 To 0 Step -1
ComboBox2.RemoveItem i
Next i

Lastrow = ws.Range("c" & Rows.Count).End(xlUp).Row
For r = 3 To Lastrow
If InStr(ws.Cells(r, 3), ComboBox2.Text) > 0 Then
ComboBox2.AddItem (ws.Range("c" & r))

'code for showing list unique values only
Dim vArr()
ReDim vArr(1 To ComboBox2.ListCount)
vArr = ComboBox2.List
Dim e
With CreateObject("scripting.dictionary")
.comparemode = 1
For Each e In vArr
If Not .exists(e) Then .Add e, Nothing
Next
If .Count Then ComboBox2.List = (.keys)
End With

End If
If ComboBox2.Text = "" Then
ComboBox2.Clear
End If
Next r
End Sub
 

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple
Sort by date Sort by votes
I dont quite understand some parts of the code...

First, why are you calling the code you are when you change the combobox in question?

What I mean, when you change the selection of Combobox2, you then clear Combobox2 (so there is nothing there to select), then populate combobox2, and then clear it out again. I am quite confused.

Second, without fully understanding what you are doing, it is pretty difficult to help you. It would greatly help us if you could put your code in code brackets. In the reply/post box you can do this with the '</>' sign at the menu bar.

Third, to answer your question, there are ways to improve what I can see, but because I dont really know what I am looking at, or understand why it is doing it, what I have put together might not help you at all.

Please see the below:

VBA Code: 
Dim Col As Collection

Private Sub ComboBox2_Change()
    Label1.Caption = ComboBox2.Text
End Sub

Sub PopulateCombobox2()
    
    Application.ScreenUpdating = False
    
    ComboBox2.Clear
    Set Col = New Collection
    
    Dim ws As Worksheet
    Set ws = ActiveSheet 'Worksheets("word by word")
    Dim Lastrow, r, i As Long
    
    Lastrow = ws.Range("c" & Rows.Count).End(xlUp).Row
    For r = 3 To Lastrow
        Dim TestString As String
        TestString = ws.Cells(r, 3)
        If TestString <> "" Then
            'this will check to see if the item is there
            Dim Ck As Boolean
            Ck = CheckIfThere(TestString)
            If Ck = False Then Col.Add (TestString) 'if not there, then add
        End If
    Next
    
    If Col.Count > 0 Then
        For i = 1 To Col.Count
            ComboBox2.AddItem (Col(i))
        Next
        ComboBox2.Text = Col(1)
    End If
    
    
    Application.ScreenUpdating = True
    
End Sub

Function CheckIfThere(LookItem As String) As Boolean
    If Col.Count > 0 Then
        For i = 1 To Col.Count
            If Col(i) = LookItem Then
                CheckIfThere = True
                Exit Function
            End If
        Next
    Else
        CheckIfThere = False
    End If
End Function

Private Sub UserForm_Initialize()
    PopulateCombobox2
    
End Sub

I assumed this would be in a userform, so I created one with a Combobox (Combobox2) and a Label (Label1) just for this example.

When the userform loads, the combobox is populated with the PopulateCombobox2 subroutine.

Inside this sub you can see that I am first running 'Application.ScreenUpdating = False'. This trick will greatly increase speed because it is telling Excel not to update the screen while the code is running. Of course you need to turn it back on when you are done.

I then run a clear on your combobox. That is much quicker than your loop to remove every entry.

Next, I am using a Collection. A collection is like a list. Some people prefer to use arrays, but I personally like collections, so I use them. I add the values into the collection so I can quickly search through it and even set an item number to select in the combobox if needed.

Then I run the loop. I kept your code roughly the same, except I didnt understand why you were comparing the value of the cell with the value of the combobox, because previously in your code you cleared the combobox, so it wouldnt have a value. With my code, I just check that the cell has something in it.

Next I run the value through a function to check to see if the value is in the collection, and if it is not, I add it.

Finally I populate the combobox with the collection and set the text of the combobox to the first value of the collection.

Before I end the code I turn back on screen updating.

This should work much faster than your previous code, but, I had to change so much that it might not work right out of the box for you. You will need to tweak it to fit your needs.

I hope this helps
 
Upvote 1
Hi
Thanks for your reply.

Actually my requirement is that when i type any keyword it should be searxhed in column C and add and show all found words in combobox list. I need to populate the combobox on each keyword press. In the start combobox list should be empty and as i remove all keywords once again combobox list should be empty.

1- In the start i am clearing the combobox list because of each keyword search and add to combobox, but when i will press the 2nd and so on keywords it will again add the found words in the list but it should remove the previous added list first.

Thanks
 
Upvote 0
Are you using a userform? If you are, you can set your userform combobox to be searchable. Please see below:

VBA Code: 
Private Sub UserForm_Initialize()

    With ComboBox1
        For i = 1 To 1000
            .AddItem (i)
        Next
  
        .AddItem ("bob")
        .AddItem ("frank")
        .AddItem ("adam")
        .AddItem ("jane")
        .AddItem ("sue")
        .AddItem ("jeff")
    End With
  

End Sub


I have a userform with 1 combobox in it. The settings are as follows in in the properties of the combobox:

AutoWordSelect: True
MatchEntry: 1 - fmMatchEntryComplete
MatchRequired: False
 

Attachments

  • autofill.JPG
    autofill.JPG
    12 KB · Views: 10
Upvote 1
frabulator said:
Are you using a userform? If you are, you can set your userform combobox to be searchable. Please see below:

VBA Code: 
Private Sub UserForm_Initialize()

    With ComboBox1
        For i = 1 To 1000
            .AddItem (i)
        Next
 
        .AddItem ("bob")
        .AddItem ("frank")
        .AddItem ("adam")
        .AddItem ("jane")
        .AddItem ("sue")
        .AddItem ("jeff")
    End With
 

End Sub


I have a userform with 1 combobox in it. The settings are as follows in in the properties of the combobox:

AutoWordSelect: True
MatchEntry: 1 - fmMatchEntryComplete
MatchRequired: False
Click to expand...
Hi

Thanks for your reply.
Yes i am using Userform.
What if there are 3 parts in a name and i remember only 2nd part and i want to type the 2nd name in the combobox. Then i need all names added in combobox list which contatin 2nd part of name.

Regards
 
Upvote 0
shakaib26 said:
Hi

Thanks for your reply.
Yes i am using Userform.
What if there are 3 parts in a name and i remember only 2nd part and i want to type the 2nd name in the combobox. Then i need all names added in combobox list which contatin 2nd part of name.

Regards
Click to expand...
And even the full name is Goldsmith (without space) and want to search with "smith"?
 
Upvote 0
One area of your code which can be improved very easily and will speed it up considerably is to change this code:
VBA Code: 
lastrow = ws.Range("c" & Rows.Count).End(xlUp).Row
For r = 3 To lastrow
If InStr(ws.Cells(r, 3), ComboBox2.Text) > 0 Then
ComboBox2.AddItem (ws.Range("c" & r))
to
VBA Code: 
lastrow = ws.Range("c" & Rows.Count).End(xlUp).Row
inarr = Range(Cells(1, 3), Cells(lastrow, 3))
For r = 3 To lastrow
If InStr(inarr(r, 1), ComboBox2.Text) > 0 Then
ComboBox2.AddItem (inarr(r, 1))
which will avoid one or two accessses to the worksheet every loop, with 80000 rows that will save a lot of time
 
Upvote 1
@shakaib26
I created a searchable combobox (in Userform) to get a fast Live Search on large data (tested on 100K data rows).
By live search I mean you get the result instantly after typing each character in the combobox.
How it works:
Type some keywords in the combobox, separated by a space, e.g "ma la", the list in the combobox will be narrowed down as you type.
The search ignores the keywords order, so keywords "ma la" will match "Maryland" and "Alabama"
The result will be displayed after you type the second character. The reason behind this is to speed up the search. Searching with 1 character will return the most results, and on large data sets it can give you a noticeable lag. Searching by 2 characters or more will be faster.
You can set this behavior in this part of the code:
VBA Code: 
Private Const CN As Long = 2  'start searching after typing certain number of character, change to suit

Akuini - userform - searchable combobox, no sort, no limit, start at n char #2.jpg


The code:
VBA Code: 
Option Explicit
Private vList, gList
Private nFlag As Boolean
Private d As Object
Dim oldVAL As String

Private Const CN As Long = 2  'start searching after typing certain number of character, change to suit

Private Sub UserForm_Initialize()
Dim va, x
    
    'load data to va
   With Sheets("Sheet1")
        va = .Range("B2", .Cells(.Rows.Count, "B").End(xlUp)) 'data start at B2 downward
   End With
    
         
         Set d = CreateObject("scripting.dictionary"): d.CompareMode = vbBinaryCompare
         For Each x In va
            d(x) = Empty
         Next
        
         If d.Exists("") Then d.Remove ""
         vList = d.keys
         d.RemoveAll
         ComboBox1.MatchEntry = fmMatchEntryNone
         
         
         Label1.Caption = "This is a searchable combobox (in Userform) to get a fast Live Search on large data"

End Sub

Private Sub ComboBox1_Change()

Dim tx1 As String
    With ComboBox1
            If nFlag = True Then Exit Sub 'don't change the list when combobox1 value is changed by DOWN ARROW or UP ARROW key
 
            tx1 = Trim(.Text)
            If Len(tx1) < CN Then .Clear:  oldVAL = tx1: gList = Empty: Exit Sub
            
            If tx1 = oldVAL Then Exit Sub
  
            If tx1 <> "" Then
                    If InStr(1, tx1, oldVAL, vbBinaryCompare) = 1 And Len(tx1) > Len(oldVAL) And Not IsEmpty(gList) Then
                        Call get_filterX(gList)
                    Else
                        Call get_filterX(vList)
                        gList = Empty
                    End If
                    
                    .List = d.keys
                    If d.Count = 0 Then gList = Empty Else gList = d.keys
                    d.RemoveAll
                    .DropDown

            Else
                    .Clear 'if Combobox1 is empty then clear the list

'                    .List = vList   'if combobox1 is empty then get whole list
            End If
        
        oldVAL = Trim(tx1)
    End With


End Sub

Sub get_filterX(ary)
'search without keyword order, case insensitive
Dim i As Long, x, z, q
Dim v As String
Dim flag As Boolean
    
    d.RemoveAll
    z = Split(UCase(ComboBox1.Value), " ")

    For Each x In ary
        flag = True: v = UCase(x)
            For Each q In z
                If InStr(1, v, q, vbBinaryCompare) = 0 Then flag = False: Exit For
            Next
        If flag = True Then d(x) = Empty
    Next

End Sub

Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

nFlag = False
    Select Case KeyCode
        Case vbKeyDown, vbKeyUp
             nFlag = True 'don't change the list when combobox1 value is changed by DOWN ARROW or UP ARROW key
    End Select
End Sub

the workbook:
www.mediafire.com

Akuini - userform - searchable combobox, no sort, no limit, start at n char #1

MediaFire is a simple to use free service that lets you put all your photos, documents, music, and video in a single place so you can access them anywhere and share them everywhere.
www.mediafire.com
 
Upvote 1
Akuini said:
@shakaib26
I created a searchable combobox (in Userform) to get a fast Live Search on large data (tested on 100K data rows).
By live search I mean you get the result instantly after typing each character in the combobox.
How it works:
Type some keywords in the combobox, separated by a space, e.g "ma la", the list in the combobox will be narrowed down as you type.
The search ignores the keywords order, so keywords "ma la" will match "Maryland" and "Alabama"
The result will be displayed after you type the second character. The reason behind this is to speed up the search. Searching with 1 character will return the most results, and on large data sets it can give you a noticeable lag. Searching by 2 characters or more will be faster.
You can set this behavior in this part of the code:
VBA Code: 
Private Const CN As Long = 2  'start searching after typing certain number of character, change to suit

View attachment 84787

The code:
VBA Code: 
Option Explicit
Private vList, gList
Private nFlag As Boolean
Private d As Object
Dim oldVAL As String

Private Const CN As Long = 2  'start searching after typing certain number of character, change to suit

Private Sub UserForm_Initialize()
Dim va, x
   
    'load data to va
   With Sheets("Sheet1")
        va = .Range("B2", .Cells(.Rows.Count, "B").End(xlUp)) 'data start at B2 downward
   End With
   
        
         Set d = CreateObject("scripting.dictionary"): d.CompareMode = vbBinaryCompare
         For Each x In va
            d(x) = Empty
         Next
       
         If d.Exists("") Then d.Remove ""
         vList = d.keys
         d.RemoveAll
         ComboBox1.MatchEntry = fmMatchEntryNone
        
        
         Label1.Caption = "This is a searchable combobox (in Userform) to get a fast Live Search on large data"

End Sub

Private Sub ComboBox1_Change()

Dim tx1 As String
    With ComboBox1
            If nFlag = True Then Exit Sub 'don't change the list when combobox1 value is changed by DOWN ARROW or UP ARROW key
 
            tx1 = Trim(.Text)
            If Len(tx1) < CN Then .Clear:  oldVAL = tx1: gList = Empty: Exit Sub
           
            If tx1 = oldVAL Then Exit Sub
 
            If tx1 <> "" Then
                    If InStr(1, tx1, oldVAL, vbBinaryCompare) = 1 And Len(tx1) > Len(oldVAL) And Not IsEmpty(gList) Then
                        Call get_filterX(gList)
                    Else
                        Call get_filterX(vList)
                        gList = Empty
                    End If
                   
                    .List = d.keys
                    If d.Count = 0 Then gList = Empty Else gList = d.keys
                    d.RemoveAll
                    .DropDown

            Else
                    .Clear 'if Combobox1 is empty then clear the list

'                    .List = vList   'if combobox1 is empty then get whole list
            End If
       
        oldVAL = Trim(tx1)
    End With


End Sub

Sub get_filterX(ary)
'search without keyword order, case insensitive
Dim i As Long, x, z, q
Dim v As String
Dim flag As Boolean
   
    d.RemoveAll
    z = Split(UCase(ComboBox1.Value), " ")

    For Each x In ary
        flag = True: v = UCase(x)
            For Each q In z
                If InStr(1, v, q, vbBinaryCompare) = 0 Then flag = False: Exit For
            Next
        If flag = True Then d(x) = Empty
    Next

End Sub

Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

nFlag = False
    Select Case KeyCode
        Case vbKeyDown, vbKeyUp
             nFlag = True 'don't change the list when combobox1 value is changed by DOWN ARROW or UP ARROW key
    End Select
End Sub

the workbook:
www.mediafire.com

Akuini - userform - searchable combobox, no sort, no limit, start at n char #1

MediaFire is a simple to use free service that lets you put all your photos, documents, music, and video in a single place so you can access them anywhere and share them everywhere.
www.mediafire.com
Click to expand...
 
Upvote 0
Akuini said:
@shakaib26
I created a searchable combobox (in Userform) to get a fast Live Search on large data (tested on 100K data rows).
By live search I mean you get the result instantly after typing each character in the combobox.
How it works:
Type some keywords in the combobox, separated by a space, e.g "ma la", the list in the combobox will be narrowed down as you type.
The search ignores the keywords order, so keywords "ma la" will match "Maryland" and "Alabama"
The result will be displayed after you type the second character. The reason behind this is to speed up the search. Searching with 1 character will return the most results, and on large data sets it can give you a noticeable lag. Searching by 2 characters or more will be faster.
You can set this behavior in this part of the code:
VBA Code: 
Private Const CN As Long = 2  'start searching after typing certain number of character, change to suit

View attachment 84787

The code:
VBA Code: 
Option Explicit
Private vList, gList
Private nFlag As Boolean
Private d As Object
Dim oldVAL As String

Private Const CN As Long = 2  'start searching after typing certain number of character, change to suit

Private Sub UserForm_Initialize()
Dim va, x
   
    'load data to va
   With Sheets("Sheet1")
        va = .Range("B2", .Cells(.Rows.Count, "B").End(xlUp)) 'data start at B2 downward
   End With
   
        
         Set d = CreateObject("scripting.dictionary"): d.CompareMode = vbBinaryCompare
         For Each x In va
            d(x) = Empty
         Next
       
         If d.Exists("") Then d.Remove ""
         vList = d.keys
         d.RemoveAll
         ComboBox1.MatchEntry = fmMatchEntryNone
        
        
         Label1.Caption = "This is a searchable combobox (in Userform) to get a fast Live Search on large data"

End Sub

Private Sub ComboBox1_Change()

Dim tx1 As String
    With ComboBox1
            If nFlag = True Then Exit Sub 'don't change the list when combobox1 value is changed by DOWN ARROW or UP ARROW key
 
            tx1 = Trim(.Text)
            If Len(tx1) < CN Then .Clear:  oldVAL = tx1: gList = Empty: Exit Sub
           
            If tx1 = oldVAL Then Exit Sub
 
            If tx1 <> "" Then
                    If InStr(1, tx1, oldVAL, vbBinaryCompare) = 1 And Len(tx1) > Len(oldVAL) And Not IsEmpty(gList) Then
                        Call get_filterX(gList)
                    Else
                        Call get_filterX(vList)
                        gList = Empty
                    End If
                   
                    .List = d.keys
                    If d.Count = 0 Then gList = Empty Else gList = d.keys
                    d.RemoveAll
                    .DropDown

            Else
                    .Clear 'if Combobox1 is empty then clear the list

'                    .List = vList   'if combobox1 is empty then get whole list
            End If
       
        oldVAL = Trim(tx1)
    End With


End Sub

Sub get_filterX(ary)
'search without keyword order, case insensitive
Dim i As Long, x, z, q
Dim v As String
Dim flag As Boolean
   
    d.RemoveAll
    z = Split(UCase(ComboBox1.Value), " ")

    For Each x In ary
        flag = True: v = UCase(x)
            For Each q In z
                If InStr(1, v, q, vbBinaryCompare) = 0 Then flag = False: Exit For
            Next
        If flag = True Then d(x) = Empty
    Next

End Sub

Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

nFlag = False
    Select Case KeyCode
        Case vbKeyDown, vbKeyUp
             nFlag = True 'don't change the list when combobox1 value is changed by DOWN ARROW or UP ARROW key
    End Select
End Sub

the workbook:
www.mediafire.com

Akuini - userform - searchable combobox, no sort, no limit, start at n char #1

MediaFire is a simple to use free service that lets you put all your photos, documents, music, and video in a single place so you can access them anywhere and share them everywhere.
www.mediafire.com
Click to expand...

Hi

WOW thats great job as per my requirement and very fast.
Can you help more if i want to search the characters at start of word no need to search in mid or end of the word?

Thank you so much.
 
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Question
TextBox to count values from ComboBox item
Replies
1
Views
125
Patriot2879
P
T
  • Question
Filter data in listbox based on three conditions by selected from combobox
Replies
1
Views
156
tubrak
T
0 Agios
  • Question
Inserting formula in range
Replies
2
Views
224
0 Agios
0 Agios
A
  • Solved
make faster code after increase data for 4000 rows for each sheet on userform
2
Replies
13
Views
916
Akuini
Akuini
R
  • Solved
Loop trough list by year and month and sum value into textbox
Replies
5
Views
421
NoSparks
N

Forum statistics

Threads
1,214,650
Messages
6,120,734
Members
448,987
Latest member
marion_davis

Share this page

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