User form is taking to long to execute

Question

I have this UserForm and it's taking to long to look up. Is there any way that I can reduce that time?

Here is the userform's textbox code where I put what I am looking for:

Private Sub TXTBUSCAART_Change()
     Application.ScreenUpdating = False

     Sheets("CONCAT").Select
     Range("A2").Select
     LSTART.Clear

     While ActiveCell.Value <> ""
         M = InStr(1, ActiveCell.Value, UCase(TXTBUSCAART.Text))

         If M > 0 Then
             LSTART.ColumnCount = 9
             LSTART.AddItem         

             LSTART.List(LSTART.ListCount - 1, 0) = ActiveCell.Value
             ActiveCell.Offset(0, 2).Select
             LSTART.List(LSTART.ListCount - 1, 1) = ActiveCell.Value
             ActiveCell.Offset(0, -1).Select
             LSTART.List(LSTART.ListCount - 1, 2) = ActiveCell.Value
             ActiveCell.Offset(0, 2).Select
             LSTART.List(LSTART.ListCount - 1, 3) = ActiveCell.Value
             ActiveCell.Offset(0, 2).Select
             LSTART.List(LSTART.ListCount - 1, 4) = ActiveCell.Value
             ActiveCell.Offset(0, -1).Select
             LSTART.List(LSTART.ListCount - 1, 5) = ActiveCell.Value
             ActiveCell.Offset(0, 3).Select
             LSTART.List(LSTART.ListCount - 1, 6) = ActiveCell.Value
             ActiveCell.Offset(0, 1).Select
             LSTART.List(LSTART.ListCount - 1, 7) = ActiveCell.Value
             ActiveCell.Offset(0, -2).Select
             LSTART.List(LSTART.ListCount - 1, 8) = ActiveCell.Value
             ActiveCell.Offset(0, -6).Select
         End If

         ActiveCell.Offset(1, 0).Select
     Wend

     Sheets("REMITO").Select
     Range("A1").Select

     Application.ScreenUpdating = False
 End Sub

FYI, there is a code review site/section: Code Review at https://codereview.stackexchange.com/ where they help improve functional code. If your code is not functional, could you give a bit more information on what you're stuck on? — Mistella, Sep 06 '18 at 01:13
Also see : http://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros — Vincent G, Sep 06 '18 at 07:05

score 1 · Accepted Answer · answered Sep 06 '18 at 07:42

It should be a lot faster to put the data into an array and loop through that - something like this (I think I got the columns right):

Private Sub TXTBUSCAART_Change()
    Dim rowCount As Long, itemCount As Long, counter As Long, n As Long
    Dim dataSheet As Worksheet
    Dim dataIn, dataOut()

    LSTART.Clear
    LSTART.ColumnCount = 9

    Set dataSheet = Sheets("CONCAT")
    With dataSheet

        rowCount = .Cells(.Rows.Count, "A").End(xlUp).Row
        itemCount = Application.WorksheetFunction.CountIf(.Range("A2:A" & rowCount), "*" & TXTBUSCAART.Text & "*")

        If itemCount > 0 Then
            ReDim dataOut(1 To itemCount, 1 To 9)
            dataIn = .Range("A2:I" & rowCount).Value
            counter = 1

            For n = 1 To UBound(dataIn)
                M = InStr(1, dataIn(1, 1), UCase(TXTBUSCAART.Text))
                If M > 0 Then
                    dataOut(counter, 1) = dataIn(n, 1)
                    dataOut(counter, 2) = dataIn(n, 3)
                    dataOut(counter, 3) = dataIn(n, 2)
                    dataOut(counter, 4) = dataIn(n, 4)
                    dataOut(counter, 5) = dataIn(n, 6)
                    dataOut(counter, 6) = dataIn(n, 5)
                    dataOut(counter, 7) = dataIn(n, 8)
                    dataOut(counter, 8) = dataIn(n, 9)
                    dataOut(counter, 9) = dataIn(n, 7)
                    counter = counter + 1
                End If
            Next

        LSTART.List = dataOut

        End If
    End With

End Sub

score 0 · Answer 2 · answered Sep 06 '18 at 01:15

You don't need to select each cell before setting its value. You can do it simply by referencing the cell object itself. Using the Cells shortcut function, if you don't ask for a specific property, the cell's value is returned by default.

So for the loop portion, you might gain some speed doing this (especially if that when loop goes around many times):

 LSTART.List(LSTART.ListCount - 1, 0) = Cells(1, 2)
 LSTART.List(LSTART.ListCount - 1, 1) = Cells(1, 4)
 LSTART.List(LSTART.ListCount - 1, 2) = Cells(1, 3)
 LSTART.List(LSTART.ListCount - 1, 3) = Cells(1, 5)
 LSTART.List(LSTART.ListCount - 1, 4) = Cells(1, 7)
 LSTART.List(LSTART.ListCount - 1, 5) = Cells(1, 6)
 LSTART.List(LSTART.ListCount - 1, 6) = Cells(1, 9)
 LSTART.List(LSTART.ListCount - 1, 7) = Cells(1, 10)
 LSTART.List(LSTART.ListCount - 1, 8) = Cells(1, 8)

Double check my math - I just added and subtracted your offsets to generate this example code.

User form is taking to long to execute

2 Answers2