VBA Search-Copy-Paste in userform is running slow

[CLE81]

Hello all,

I have an Excel VBA in a userform which is running quit slow.
(It's programmed in a Userform because I want to show the pogress with a progress bar.)

Case:
I have an VBA script in an Userform which has to search in a long list with items (sheet 1). The keyword which is used to search is configured on another sheet (sheet 2). When a keyword is found in the large list, the entire row has to be copied an paste in a specific worksheet (sheet 3).

There can be configured more then one keywords on the config sheet (sheet 2) and there are more items on the config sheet with their own keywords.

This find-copy-paste action has to be done twice because there are 2 languages configured (2 kind of sheet 1)

As attachement and image for more explanation.

Problem:
At this moment my VBA is searching the entire list of items with the keywords one-by-one which is taking a very long time.

Question:
Is there an option in VBA to search-copy-paste row with a range of variables so this action is taking less time?
Or
Did I program an code which does to many handlings?
At the moment there are 5000 rows * 6 items * with each +/- 4 keywords * 2 languages = 124000 scan/ check actions an it takes approx. 10 minutes.


Code:

Private Sub UserForm_Activate()
' ---------------------- Declare variables -------------------------------------------
    Dim i, j, k, m As Integer
    Dim HMI_name, HMI_Class, HMI_destination, sh_source As String

    HMI_config = "HMI_Config"
    searchcolumn = "E"
     
    'Count configured lanuages
    sh_name = "Select"
    AmountLanguages = Sheets(sh_name).Cells(Rows.Count, 5).End(xlUp).Row
   
    For m = 2 To AmountLanguages
            'Set language
            Language = ActiveWorkbook.Sheets(sh_name).Cells(m, 5)
           
' ---------------------- Search for available HMI's ----------------------------------
          Final_HMI = Sheets(HMI_config).Cells(1, ActiveSheet.Columns.Count).End(xlToLeft).Column
               
          For k = 1 To Final_HMI
            HMI_destination = "#" & ActiveWorkbook.Sheets(HMI_config).Cells(1, k) & "_" & Language
                  
            ' Search for HMI destination
            If (HMI_destination <> "") Then
                   
    ' ---------------------- Search for configured Alarm class ----------------------------
                    Final_Class = Sheets(HMI_config).Cells(Rows.Count, k).End(xlUp).Row
   
                    For j = 2 To Final_Class
                        HMI_Class = Sheets(HMI_config).Cells(j, k)
                       
                            If (HMI_Class <> "") Then
                                                               
    ' ---------------------- Copy/ Paste alarms in correct HMI sheet ----------------------
                                Dim Finalrow As Integer
                               
                                sh_source = "DiscreteAlarms_" & Language
                               
                                Finalrow = Sheets(sh_source).Cells(Rows.Count, 1).End(xlUp).Row
                               
                                ' Loop through each row of overall alarmlist
                                For i = 2 To Finalrow
                                   
                                    ' Decide if to copy based on column Class
                                    Column_txt = Sheets(sh_source).Range(searchcolumn & i)
                                    If InStr(1, Column_txt, HMI_Class) <> 0 Then
                                        'Copy
                                        Sheets(sh_source).Cells(i, 1).Resize(1, 33).Copy
                                        'Paste
                                        NextRow = Sheets(HMI_destination).Cells(Rows.Count, 1).End(xlUp).Row + 1
                                        ActiveSheet.Paste Destination:=Worksheets(HMI_destination).Cells(NextRow, 1)
                                        Application.CutCopyMode = False
                                End If
                            Next i
    ' ---------------------------------------------------------------------------------------
                        End If
                    Next j
    ' ---------------------------------------------------------------------------------------
                End If
            Next k
    ' ---------------------------------------------------------------------------------------
        Next m
    ' ---------------------------------------------------------------------------------------
   
    'Open frontpage[ATTACH type="full"]26636[/ATTACH]
    ActiveWorkbook.Sheets("Voorblad").Activate
    Application.ScreenUpdating = True
End Sub

 

[CLE81]

It's working!

Many thanks for the support.