make faster code after increase data for 4000 rows for each sheet on userform

[abdelfattah]

Hello
I need improving the code . it becomes slow when search by combobox on userform . the data became 4000 rows for each sheet .
the code will populate data in listbox when call from macro LBoxPop based on sheet selection from combobox1

Option Explicit
Option Compare Text

Private Data, Temp, Crit As String, i As Long, lr As Long, ii As Long, x As Long
Dim ws As Worksheet



Private Sub ComboBox1_Change()
'ActiveSheet.Visible = True
If ComboBox1.Value <> "" Or ComboBox2.Value <> "" Then OptionButton1.Value = False: OptionButton2.Value = False
 If ComboBox1.Value <> "" And ComboBox2.Value <> "" Then
  TextBox1.Value = ""
  TextBox2.Value = ""
  TextBox3.Value = ""
  
  CommandButton1.Enabled = True
  
  End If
  If ComboBox1.Value = "" Then ListBox1.Clear
  If ComboBox1.Value = "" Then TextBox1.Value = "": TextBox2.Value = "": TextBox3.Value = ""
  If ComboBox1.Value <> "" Or ComboBox2.Value = "" Then TextBox4.Visible = False: TextBox5.Visible = False: TextBox6.Visible = False: _
  TextBox1.Visible = True: TextBox2.Visible = True: TextBox3.Visible = True
  
  If ComboBox1.Value = "" Then Exit Sub

Set ws = Sheets(ComboBox1.Value)

ws.Activate

With ws
lr = .Range("A" & Rows.Count).End(xlUp).Row
TextBox1.Value = .Range("C" & lr).Value
TextBox2.Value = .Range("D" & lr).Value
TextBox3.Value = .Range("E" & lr).Value
If TextBox3.Value < 0 Then
TextBox3.ForeColor = vbRed
Else: TextBox3.ForeColor = vbBlack
End If
End With

  Call LBoxPop

  
 

End Sub

[CODE=vba]
Private Sub LBoxPop()
    Dim r          As Long, C As Long
    Dim Data()     As Variant
    Dim rng        As Range
    
     
   
    Set rng = ws.Cells(1, 1).CurrentRegion
    ReDim Data(1 To rng.Rows.Count, 1 To rng.Columns.Count + 1)
 
    For r = 1 To UBound(Data, xlRows)
        For C = 1 To UBound(Data, xlColumns)
            Data(r, C) = rng.Cells(r, C).Text
        Next C
    Next r
 
    With UserForm1.ListBox1
        .ColumnCount = 5
        .columnWidths = "80;335;100;100;100"
        .List = Data
    End With
    
        For i = ListBox1.ListCount - 1 To 0 Step -1

    Debug.Print i, ListBox1.List(i, 0)
      If ListBox1.List(i, 0) <> "" Then
        ListBox1.ListIndex = i
        Exit For
      End If
    Next i
  'End With
 


 
End Sub

thanks

 

[abdelfattah]

Thanks Akuini for your trying !
I don't see any difference , sorry !
by the way your suggestion will delete number format from columns contain numeric values in listbox .

 

[Akuini]

by the way your suggestion will delete number format from columns contain numeric values in listbox .

if you want to apply the number format, uncomment this line:

'    For i = 1 To UBound(Data, 1)
'        Data(i, 3) = Format(Data(i, 3), "0.00")
'        Data(i, 4) = Format(Data(i, 4), "0.00")
'        Data(i, 5) = Format(Data(i, 5), "0.00")
'    Next

I don't see any difference , sorry !

Sorry, I have no other idea.
Your original code looped through a range directly, which is usually slow for large data. Therefore, I changed it to loop through an array, which should be faster.
Hopefully, somebody will be able to assist you.

 

[abdelfattah]

Hi Akuini
I want to thank you for your modifying .
your modifying is really fast. I don't know what my bad to say you I don't see any difference , sorry !
much appreciated for your help.

 

[Akuini]

You're welcome, glad to help & thanks for the feedback.