Fixing complicated error populate data in listbox based on combobox and textbox
Solved/Closed
abdelfatah_0230
Posts
73
Registration date
Thursday 18 July 2019
Status
Member
Last seen
23 July 2022
-
19 Jul 2020 à 06:11
abdelfatah_0230 Posts 73 Registration date Thursday 18 July 2019 Status Member Last seen 23 July 2022 - 7 Aug 2020 à 07:07
abdelfatah_0230 Posts 73 Registration date Thursday 18 July 2019 Status Member Last seen 23 July 2022 - 7 Aug 2020 à 07:07
Related:
- Fixing complicated error populate data in listbox based on combobox and textbox
- Error network error occurred - Guide
- Cmos checksum error - Guide
- Tmobile data check - Guide
- Ps3 error 80023017 - PS3 & PS4 Forum
- Error 491 play store - Guide
5 responses
TrowaD
Posts
2921
Registration date
Sunday 12 September 2010
Status
Contributor
Last seen
27 December 2022
555
4 Aug 2020 à 12:16
4 Aug 2020 à 12:16
Hi Abdel,
You are right. The problem is data types. You have 3: Text, number and date. We need to check them individualy. Doing that creates another problem; comparing a, for example, number as date creates an error.
A short story shorter; a lot of error handling added.
Here is your code:
Hopefully that covers all the bases :)
Best regards,
Trowa
You are right. The problem is data types. You have 3: Text, number and date. We need to check them individualy. Doing that creates another problem; comparing a, for example, number as date creates an error.
A short story shorter; a lot of error handling added.
Here is your code:
Private Sub CommandButton2_Click()
Dim MyValue
Dim MyAr() As String
Dim ib As Boolean
Dim R As Integer, i As Integer, ii As Integer
Dim MyColmnFind As Integer, Lastrow As Integer
Dim dt1 As Date, dt2 As Date
'-------------------------
MyColmnFind = Me.ComboBox1.ListIndex + 1
If MyColmnFind = 0 Then Exit Sub
If MyColmnFind = 3 Then Me.TextBox10 = ""
'-------------------------
Me.ListBox1.Clear
'-------------------------
With sRng.Worksheet
Lastrow = .Range("A65536").End(xlUp).Row
If IsDate(Me.DTPicker1) Then dt1 = DateValue(Me.DTPicker1) Else dt1 = WorksheetFunction.Min(.Range("a3").Resize(Lastrow)): Me.DTPicker1 = Format(dt1, DateFormt)
If IsDate(Me.DTPicker2) Then dt2 = DateValue(Me.DTPicker2) Else dt2 = WorksheetFunction.Max(.Range("a3").Resize(Lastrow)): Me.DTPicker2 = Format(dt2, DateFormt)
End With
'-------------------------
sColmn = ""
With sRng
For R = 2 To Lastrow
On Error GoTo NextCheck ' When the line below creates a type mismatch error because the textbox value isn't a date then got to line NextCheck
If .Cells(R, MyColmnFind).Value = DateValue(TextBox1.Value) Then GoTo addArr ' When there isn't an error and the data matches, then continue to add data row to MyAr
NextCheck:
On Error GoTo -1 ' Resets error
On Error GoTo NextCheck2 ' When the line below creates a type mismatch error because the textbox value isn't a number then got to line NextCheck2
If .Cells(R, MyColmnFind).Value = CInt(TextBox1.Value) Then GoTo addArr
NextCheck2:
On Error GoTo -1
If .Cells(R, MyColmnFind).Value = TextBox1.Value Then
addArr:
Select Case .Cells(R, 1).Value: Case dt1 To dt2
ib = InStr(1, .Cells(R, MyColmnFind), Me.TextBox10, vbTextCompare) = 1
If ib Then
sColmn = sColmn & R & " "
ii = ii + 1
ReDim Preserve MyAr(1 To ContColmn, 1 To ii)
For i = 1 To ContColmn
If IsDate(.Cells(R, i)) Then MyValue = Format(.Cells(R, i).Value, DateFormt) _
Else MyValue = .Cells(R, i).Value
MyAr(i, ii) = MyValue
Next
End If
End Select
End If
Next
End With
If ii Then Me.ListBox1.Column = MyAr: Me.ListBox1.ListIndex = 0
End Sub
Hopefully that covers all the bases :)
Best regards,
Trowa
grorge441
Posts
23
Registration date
Tuesday 7 July 2020
Status
Member
Last seen
24 April 2021
12
22 Jul 2020 à 03:18
22 Jul 2020 à 03:18
abdelfatah_0230
Posts
73
Registration date
Thursday 18 July 2019
Status
Member
Last seen
23 July 2022
22 Jul 2020 à 03:48
22 Jul 2020 à 03:48
thanks grorge for your trying to help me actually , your suggestion is the same thing somebody advised me but i think the problem is not the system in windows i thing the problem is in the code because i run this original code in the same pc system win7 works normally when i changed the ranges and the names sheets, tools in userform it gives me error
thanks advance
thanks advance
TrowaD
Posts
2921
Registration date
Sunday 12 September 2010
Status
Contributor
Last seen
27 December 2022
555
23 Jul 2020 à 11:22
23 Jul 2020 à 11:22
Hi Abdel,
Could you post your workbook? I will see what I can do.
Best regards,
Trowa
Could you post your workbook? I will see what I can do.
Best regards,
Trowa
abdelfatah_0230
Posts
73
Registration date
Thursday 18 July 2019
Status
Member
Last seen
23 July 2022
23 Jul 2020 à 15:09
23 Jul 2020 à 15:09
hi , Trowa this is my file
https://www.dropbox.com/scl/fi/42rw06m8pdmkx1jir6z5a/CUS1.xlsm?dl=0&rlkey=es7dl2g4uw3h61ujkblv1kvf7
https://www.dropbox.com/scl/fi/42rw06m8pdmkx1jir6z5a/CUS1.xlsm?dl=0&rlkey=es7dl2g4uw3h61ujkblv1kvf7
TrowaD
Posts
2921
Registration date
Sunday 12 September 2010
Status
Contributor
Last seen
27 December 2022
555
28 Jul 2020 à 11:48
28 Jul 2020 à 11:48
Hi Abdel,
Your ComboBox1 has a RowSource value. Remove the value SOURCE as seen in the screengrab below:
Best regards,
Trowa
Your ComboBox1 has a RowSource value. Remove the value SOURCE as seen in the screengrab below:
Best regards,
Trowa
abdelfatah_0230
Posts
73
Registration date
Thursday 18 July 2019
Status
Member
Last seen
23 July 2022
28 Jul 2020 à 14:19
28 Jul 2020 à 14:19
yes , it works but i need your help about another problem when i choose from combobox customer name and write name it shows me all of data it supposes showing only data of specific name written in textbox 1 also the same problem if i choose invoice no it shows all of data not data of specific invoice
thanks advance
thanks advance
TrowaD
Posts
2921
Registration date
Sunday 12 September 2010
Status
Contributor
Last seen
27 December 2022
555
30 Jul 2020 à 11:40
30 Jul 2020 à 11:40
Hi Abdel,
For that request I added an IF statement to the code behind the search button. The green text shows what I changed/added.
Here is the code:
Best regards,
Trowa
For that request I added an IF statement to the code behind the search button. The green text shows what I changed/added.
Here is the code:
Private Sub CommandButton2_Click() ' ***** Changed 3 to 2 since there is no CommandButton3
Dim MyValue
Dim MyAr() As String
Dim ib As Boolean
Dim R As Integer, i As Integer, ii As Integer
Dim MyColmnFind As Integer, Lastrow As Integer
Dim dt1 As Date, dt2 As Date
'-------------------------
MyColmnFind = Me.ComboBox1.ListIndex + 1
If MyColmnFind = 0 Then Exit Sub
If MyColmnFind = 3 Then Me.TextBox10 = ""
'-------------------------
Me.ListBox1.Clear
'-------------------------
With sRng.Worksheet
Lastrow = .Range("A65536").End(xlUp).Row
If IsDate(Me.DTPicker1) Then dt1 = DateValue(Me.DTPicker1) Else dt1 = WorksheetFunction.Min(.Range("a3").Resize(Lastrow)): Me.DTPicker1 = Format(dt1, DateFormt)
If IsDate(Me.DTPicker2) Then dt2 = DateValue(Me.DTPicker2) Else dt2 = WorksheetFunction.Max(.Range("a3").Resize(Lastrow)): Me.DTPicker2 = Format(dt2, DateFormt)
End With
'-------------------------
sColmn = ""
With sRng
For R = 2 To Lastrow
If .Cells(R, MyColmnFind).Value2 = TextBox1.Value Then ' ***** Added an IF statement to check if data row needs to be added to MyAr
Select Case .Cells(R, 1).Value2: Case dt1 To dt2
ib = InStr(1, .Cells(R, MyColmnFind), Me.TextBox10, vbTextCompare) = 1
If ib Then
sColmn = sColmn & R & " "
ii = ii + 1
ReDim Preserve MyAr(1 To ContColmn, 1 To ii)
For i = 1 To ContColmn
If IsDate(.Cells(R, i)) Then MyValue = Format(.Cells(R, i).Value2, DateFormt) _
Else MyValue = .Cells(R, i).Value2
MyAr(i, ii) = MyValue
Next
End If
End Select
End If ' ***** Added line
Next
End With
If ii Then Me.ListBox1.Column = MyAr: Me.ListBox1.ListIndex = 0
End Sub
Best regards,
Trowa
abdelfatah_0230
Posts
73
Registration date
Thursday 18 July 2019
Status
Member
Last seen
23 July 2022
30 Jul 2020 à 14:34
30 Jul 2020 à 14:34
your code works only when i select customer name but the rest of choices in combobox doesn't show any thing like invoice no or customer no ..etc i hope you can fix it
best regards
abdelfattah
best regards
abdelfattah
7 Aug 2020 à 07:07
Best regards,
abdelfattah