Textbox Searchbar and Listbox - 4 - excel

Question

I have simple a stock list which is working with a textbox and a listbox.
When i write a word to textbox ( like flange ), i can see every stock name which is including same word at the listbox. ( i can see every stock name which is including flange word at listbox.)
Below codes work fine in my computer.
But when i send this excel sheet to another computer, Listbox is getting smaller and smaller when i type any keyboard key.
How could i avoid this error?
How could i work with this excel sheet in everyone's pc without having this problem?
Is anyone have an idea?
Private Sub TextBox1_Change()
'To avoid any screen update until the process is finished
Application.ScreenUpdating = False
'This method must make sure to turn this property back to True before exiting by
' always going through the exit_sub label
On Error GoTo err_sub
'This will be the string to filter by
Dim filterSt As String: filterSt = Me.TextBox1.Text & ""
'This is the number of the column to filter by
Const filterCol As Long = 4 'This number can be changed as needed
'This is the sheet to load the listbox from
Dim dataSh As Worksheet: Set dataSh = Worksheets("T?mListe") 'The sheet name can be changed as needed
'This is the number of columns that will be loaded from the sheet (starting with column A)
Const colCount As Long = 6 'This constant allows you to easily include more/less columns in future
'Determining how far down the sheet we must go
Dim usedRng As Range: Set usedRng = dataSh.UsedRange
Dim lastRow As Long: lastRow = usedRng.Row - 1 + usedRng.Rows.Count
Dim c As Long
'Getting the total width of all the columns on the sheet
Dim colsTotWidth As Double: colsTotWidth = 0
For c = 1 To colCount
colsTotWidth = colsTotWidth + dataSh.Columns(c).ColumnWidth
Next
'Determining the desired total width for all the columns in the listbox
Dim widthToUse As Double
'Not sure why, but subtracting 4 ensured that the horizontal scrollbar would not appear
widthToUse = Me.ListBox1.Width - 4
If widthToUse < 0 Then widthToUse = 0
'Making the widths of the listbox columns proportional to the corresponding column widths on the sheet;
' thus, the listbox columns will automatically adjust if the column widths on the sheet are changed
Dim colWidthSt As String: colWidthSt = "" 'This will be the string used to set the listbox's column widths
Dim totW As Double: totW = 1
For c = 1 To colCount
Dim w As Double
If c = colCount Then 'Use the remaining width for the last column
w = widthToUse - totW
Else 'Calculate a proportional width
w = dataSh.Columns(c).ColumnWidth / colsTotWidth * widthToUse
End If
'Rounding to 0 decimals and using an integer to avoid localisation issues
' when converting the width to a string
Dim wInt As Long: wInt = Round(w, 0)
If wInt < 1 And w > 0 Then wInt = 1
totW = totW + wInt
If c > 1 Then colWidthSt = colWidthSt & ","
colWidthSt = colWidthSt & wInt
Next
'Reset the listbox
Me.ListBox1.Clear
Me.ListBox1.ColumnCount = colCount
Me.ListBox1.ColumnWidths = colWidthSt
Me.ListBox1.ColumnHeads = False
'Reading the entire data sheet into memory
Dim dataArr As Variant: dataArr = dataSh.UsedRange
If Not IsArray(dataArr) Then dataArr = dataSh.Range("A1:A2")
'If filterCol is beyond the last column in the data sheet, leave the list blank and simply exit
If filterCol > UBound(dataArr, 2) Then GoTo exit_sub 'Do not use Exit Sub here, since we must turn ScreenUpdating back on
'This array will store the rows that meet the filter condition
ReDim filteredArr(1 To UBound(dataArr, 1), 1 To UBound(dataArr, 2)) 'Make room for the maximum possible size
Dim filteredCount As Long: filteredCount = 0
'Copy the matching rows from [dataArr] to [filteredArr]
'IMPORTANT ASSUMPTION: The first row on the sheet is a header row
Dim r As Long
For r = 1 To lastRow
'The first row will always be added to give the listbox a header
If r > 1 And InStr(1, dataArr(r, filterCol) & "", filterSt, vbTextCompare) = 0 Then
GoTo continue_for_r
End If
'NB: The Like operator is not used above in case [filterSt] has wildcard characters in it
' Also, the filtering above is case-insensitive
' (if needed, it can be changed to case-sensitive by changing the last parameter to vbBinaryCompare)
filteredCount = filteredCount + 1
For c = 1 To colCount
filteredArr(filteredCount, c) = dataArr(r, c)
Next
continue_for_r:
Next
'Copy [filteredArr] to a new array with the right dimensions
If filteredCount > 0 Then
'Unfortunately, Redim Preserve cannot be used here because it can only resize the last dimension;
' therefore, we must manually copy the filtered data to a new array
ReDim filteredArr2(1 To filteredCount, 1 To colCount)
For r = 1 To filteredCount
For c = 1 To colCount
filteredArr2(r, c) = filteredArr(r, c)
Next
Next
Me.ListBox1.List = filteredArr2
End If
ListBox1.Height = 772
ListBox1.Width = 1300
ListBox1.Top = 75
exit_sub:
Application.ScreenUpdating = True
Exit Sub
err_sub:
MsgBox "Error " & Err.Number & vbCrLf & vbCrLf & Err.Description
Resume exit_sub 'To make sure that screen updating is turned back on
End Sub
Thanks in advance.