Excel vba runing slowly, high cpu usage-CodePudding

I'm actually facing a problem. I have to use Excel to build a database, and I'm going through some troubles.

I'm using a sheet as a table, and columns as fields. Some tables are relating to others with ID fields as we could make with a relational database.

My problem is that a piece of my code is running really slowly and use up to 60% of my CPU.

Database users needs to see in real time while they're typing if a duplicate value exist in the table they're manipulating.

Private Sub UserForm_Initialize()
    'Loading Form.
    Load Me
    
    'Initialisation of Filtered Data Sheet.
    Dim wsData As Worksheet
    Set wsData = Worksheets("DonneesFiltrees")
    
    'Disable screen update so the user do not see sheet with data wrote on it.
    Application.ScreenUpdating = False
    
    'Initialize the sheet the user wants to use.
    Set usingWs = Worksheets("Listes")
    usingWs.Visible = xlSheetVisible
    usingWs.Select
    
    'Sends data to Filtered Data Sheet.
    Call ModuleDonnees.TransferToFilterByName(usingWs, "Devises")
    
    'Populate the userForm list from Filtered Data Sheet
    Me.listExistants.ColumnCount = 1
    Me.listExistants.RowSource = populateList(wsData, "A")
    
End Sub

Unfortunately I'm executing all this code at each letters user is typing may it is too heavy for excel but this is my boss demand...

Private Sub txtNom_Change()
    
    'Initalize Filtered Data Sheet
    Dim wsData As Worksheet
    Dim FilteredRange As Range
    Set wsData = Worksheets("DonneesFiltrees")
    
    'Apply filter on Source Data Sheet. Sort of : Select * In 'myTable' Where Name Like 'UserRequest';
    usingWs.ListObjects("Devises").DataBodyRange.AutoFilter Field:=1, Criteria1:="=*" & Me.txtNom.Value & "*", Operator:=xlAnd
    
    
    'Get the Filtered Data Range
    On Error Resume Next
    Set FilteredRange = usingWs.ListObjects("Devises").DataBodyRange.SpecialCells(xlCellTypeVisible)
    
    'If the filtered data range is empty, the data doesn't exist, we can write it in the DB.
    If FilteredRange Is Nothing Then
        wsData.ListObjects(1).DataBodyRange.Clear
        isOk = True
    Else
        'If the filtered data range isn't empty refresh data by sending filtered data from source sheet
        'to the filtered data sheet. So the user see datas matching what he's typing.
        Call ModuleDonnees.TransferToFilterByName(usingWs, "Devises")
        
        isOk = False
    End If
    
End Sub

Private Sub btnAjout_Click()
    
    Dim newRow As ListRow
    
    
    'Clearing Filter
    usingWs.ListObjects("Devises").AutoFilter.ShowAllData
    
    'This Condition is used to Match if the data really exist
    'Lets admit than the user wants to write Ira as a country
    'Iraq and Iran exists and will be in the list of existing values but are not exactly the same
    'in this case we should let the user write it.
    If isOk = False Then
        
        i = 0
        
        Do While (i < Me.listExistants.ListCount - 1)
            If Me.listExistants.List(i) = Me.txtNom.Value Then
                isOk = False
                Exit Do
            Else
                isOk = True
                i = i   1
            End If
        Loop
    
    End If
    
    If isOk = True Then
    
        'Asking for validation before he write the data.
        Confirmation = MsgBox("Voulez-vous confirmer la saisie de données ?", 36, "Confirmation")
        
        If Confirmation = vbNo Then
            MsgBox "Saisie annulée"
            Exit Sub
        ElseIf Confirmation = vbYes Then
        
        
            
            'Add row
            Set newRow = usingWs.ListObjects("Devises").ListRows.Add
            
            'Write the value
            With newRow
                .Range(1) = Me.txtNom.Value
            End With
            
            'Validation Message
            MsgBox "La devise a bien été ajouté à la base de données"
    
            'Closing Form
            Unload Me
    
    Else
        'If is Ok still false it means that the data already exists in database so we block the user
        
        MsgBox "Il semblerait que votre saisie existe déjà dans la base de données"
        Unload Me
        Exit Sub
    End If
    
End Sub

There are my importing data methods,

'As I'm using tables I copy the header range and then body range and transform it to a table
Function TransferToFilterByName(ws As Worksheet, tableName As String)

    Dim wsData As Worksheet
    Set wsData = Worksheets("DonneesFiltrees")
    Dim FilteredRange As Range
    
    wsData.Cells.Clear


    ws.Visible = xlSheetVisible
    ws.Select
    ws.ListObjects(tableName).HeaderRowRange.Copy Destination:=wsData.Range("A1")
    
    
    ws.Select
    Set FilteredRange = ws.ListObjects(tableName).DataBodyRange.SpecialCells(xlCellTypeVisible)
    
    FilteredRange.Copy Destination:=wsData.Range("A2")

    Call ConvertToTable

End Function

Function ConvertToTable()

    Dim tbl As Range
    Dim ws As Worksheet
    
    Application.ScreenUpdating = False
    
    Set ws = Worksheets("DonneesFiltrees")
    Set tbl = ws.Range("A1").CurrentRegion
    
    ws.ListObjects.Add(SourceType:=xlSrcRange, Source:=tbl, xllistobjecthasheaders:=xlYes).Name = "DonneesFiltrees"
    
End Function

There's all my code used for Adding data to some sheets, but as I said before this is using like 50 to 60% of my CPU, and this is running kind of slowly despite of the little amount of data.

Is this only because of executing it on userForm txtBox_Change() ? Or is there a way to optimize it without changing it.

Any help would be higly appreciated.

Thanks in advance.

CodePudding user response：

I'll admit I don't quite follow all of your logic as, after filtering your Devises table, and checking for visible rows, it seems to stay filtered even when there aren't any ? Some re-organisation I would suggest (in as much as I understand your code) would be not to do any filtering in txtNom_Change() - instead just use the MATCH() method of the WorksheetFunction object, since it happily copes with wildcards. Then, do the actual filtering of your Devises table within the TransferToFilterByName() procedure where it will always be necessary. (building on FunThomas' comment, since you already know SQL, this is an excellent playlist on how to use it/ADODB in Excel)