delay in response and hang in excel vba processing-CodePudding

Hi every one I've written a code in Excel VBA it works , the code searches a worksheet and list the result in a list box specifying which columns to list but it takes very long time in responding to any change in search so I need to know the bug here is the code

Private Sub TbSearch_Change()
    Dim i As Long
    Dim MySheet As Worksheet
    With MySheet
        On Error Resume Next
        Set edRng = .Range("A4", .Range("A4").End(xlDown))
    End With
    'Set MySheet = Main
    'On Error Resume Next
    'Me.TbSearch.Text = StrConv(Me.TbSearch.Text, vbProperCase)

    Me.LBResult.Clear

    If CBRoads <> "" Then
        For i = 4 To Application.WorksheetFunction.CountA(edRng)
            For x = 1 To 5
                a = Len(Me.TbSearch.Text)
                If Left(MySheet.Cells(i, x).Value, a) = Me.TbSearch.Text And Me.TbSearch.Text <> "" Then

                    Me.LBResult.AddItem MySheet.Cells(i, 2).Value

                    For Each edCell In Me.LBResult.List
      
                        Me.LBResult.List(LBResult.ListCount - 1, 1) = MySheet.Cells(i, 3).Value
                        Me.LBResult.List(LBResult.ListCount - 1, 2) = MySheet.Cells(i, 8).Value
                        Me.LBResult.List(LBResult.ListCount - 1, 3) = MySheet.Cells(i, 9).Value
                        Me.LBResult.List(LBResult.ListCount - 1, 4) = MySheet.Cells(i, 10).Value
                        Me.LBResult.List(LBResult.ListCount - 1, 4) = MySheet.Cells(i, 12).Value
                    Next edCell

                End If
            Next x
        Next i
    Else
        MsgBox "choose first"
        Me.CBRoads.SetFocus
    End If
End Sub

CodePudding user response：

There is no reason to iterate over each item in Me.LBResult.List. It is killing your performance.

 For Each edCell In Me.LBResult.List