CODEWITHSUNDEEP
excelvbatextboxuserform
JUAN CARLOS PERON
JUAN CARLOS PERON

Reputation: 17

User form is taking to long to execute

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

Upvotes: 0

Views: 60

Answers (2)

Rory
Rory

Reputation: 34045

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

Upvotes: 1

TFrazee
TFrazee

Reputation: 807

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.

Upvotes: 0

Related Questions