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:
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:
VBA 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