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

Answer 1

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