• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Userform : Opposite to IsNumeric Function

sn152

sn152

Member
I have a userform in which if I enter the ID it pulls the data related to that ID and displays it in the labels and texboxes in the userform. I am using the below code to do this.
Now the problem is this code works only when the ID is a number. But I have IDs which are text and numbers. For example - EMP1022. When I enter text it is showing an error. Could you please help me on this.

Code: 
Private Sub TextBox1_Change()
Dim m As Integer, id As Long
Dim l As Long, dictionary As Object, i, t As Long

Set dictionary = CreateObject("scripting.dictionary")
If IsNumeric(Me.TextBox1.Value) Then
    Me.Label11.Caption = ""
    Me.Label13.Caption = ""
    Label3.Caption = ""
    Label13.Caption = ""
    Label5.Caption = ""
    ListBox1.Clear
    Label7.Caption = ""
    Label9.Caption = ""
    TextBox2.Value = ""
    Label15.Caption = ""
    Label17.Caption = ""
    Label19.Caption = ""
    Label26.Caption = ""
    OptionButton3.Value = False
    OptionButton2.Value = False
    OptionButton1.Value = False

    Me.ListBox1.Clear
    For t = 3 To 34
    On Error Resume Next
        Me.Controls("TextBox" & t).Value = ""
    Next t
    On Error GoTo 0
    id = Me.TextBox1.Value
    m = 0
        Do While Sheet3.Cells(m + 1, 1) <> ""
            If Sheet3.Cells(m + 1, 1).Value = id Then
                Me.Label3.Caption = Sheet3.Cells(m + 1, 2)
                Me.Label5.Caption = Sheet3.Cells(m + 1, 3)
                Me.Label7.Caption = Sheet3.Cells(m + 1, 4)
                Me.Label9.Caption = Sheet3.Cells(m + 1, 5)
                Me.Label11.Caption = Sheet3.Cells(m + 1, 6)
                Me.Label13.Caption = Sheet3.Cells(m + 1, 7)
                Me.Label15.Caption = Sheet3.Cells(m + 1, 8)
                Me.Label17.Caption = Sheet3.Cells(m + 1, 9)
                Me.Label19.Caption = Sheet3.Cells(m + 1, 10)
                Me.Label26.Caption = Sheet3.Cells(m + 1, 11)
                l = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
                On Error Resume Next
                    If l < 2 Then l = 2
                        For i = 2 To l
                            If Sheet1.Cells(i, 2) = id Then
                                dictionary.Add Sheet1.Cells(i, 18).Value, 1
                            End If
                        Next
                        Me.ListBox1.List = dictionary.keys
            End If
            m = m + 1
        Loop
Else
End If

If Me.TextBox1.Value = "" Then
Label3.Caption = ""
Label13.Caption = ""
Label5.Caption = ""
ListBox1.Clear
Label7.Caption = ""
Label9.Caption = ""
TextBox2.Value = ""
Label11.Caption = ""
Label15.Caption = ""
Label17.Caption = ""
Label19.Caption = ""
Label26.Caption = ""
OptionButton3.Value = False
OptionButton2.Value = False
OptionButton1.Value = False

End If
End Sub
[\CODE]
Thanks!
 
Check it...


Code: 
Private Sub TextBox1_Change()
Dim m As Integer, id As String
Dim l As Long, dictionary As Object, i As Long, t As Long

'======================================
Label3.Caption = ""
Label13.Caption = ""
Label5.Caption = ""
ListBox1.Clear
Label7.Caption = ""
Label9.Caption = ""
TextBox2.Value = ""
Label11.Caption = ""
Label15.Caption = ""
Label17.Caption = ""
Label19.Caption = ""
Label26.Caption = ""
OptionButton3.Value = False
OptionButton2.Value = False
OptionButton1.Value = False
'======================================

'--------------------------------------------
If Not Me.TextBox1.Value <> "" Then Exit Sub
'--------------------------------------------
Set dictionary = CreateObject("scripting.dictionary")

    Me.ListBox1.Clear
    For t = 3 To 34
    On Error Resume Next
        Me.Controls("TextBox" & t).Value = ""
    Next t
    On Error GoTo 0
    id = Me.TextBox1.Value
    m = 0
        Do While Sheet3.Cells(m + 1, 1) <> ""
            If Sheet3.Cells(m + 1, 1).Value = id Then
                Me.Label3.Caption = Sheet3.Cells(m + 1, 2)
                Me.Label5.Caption = Sheet3.Cells(m + 1, 3)
                Me.Label7.Caption = Sheet3.Cells(m + 1, 4)
                Me.Label9.Caption = Sheet3.Cells(m + 1, 5)
                Me.Label11.Caption = Sheet3.Cells(m + 1, 6)
                Me.Label13.Caption = Sheet3.Cells(m + 1, 7)
                Me.Label15.Caption = Sheet3.Cells(m + 1, 8)
                Me.Label17.Caption = Sheet3.Cells(m + 1, 9)
                Me.Label19.Caption = Sheet3.Cells(m + 1, 10)
                Me.Label26.Caption = Sheet3.Cells(m + 1, 11)
                l = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
                On Error Resume Next
                    If l < 2 Then l = 2
                        For i = 2 To l
                            If Sheet1.Cells(i, 2) = id Then
                                dictionary.Add Sheet1.Cells(i, 18).Value, 1
                            End If
                        Next
                        Me.ListBox1.List = dictionary.keys
            End If
            m = m + 1
        Loop
Set dictionary = Nothing
End Sub
 
Thanks Deepak. This is working. But I have a new problem now. This same userform is also used to enter details and when I click on submit is transfers the data to Sheet1. Then when I again enter the same ID and select date and click on retrive (commandbutton2) it retrieves the data from the sheet 1 for that ID.

Now when I enter the ID and click on retrieve it says "pls enter a valid ID".

Below is the complete code.

Code: 
Private Sub TextBox1_Change()
Dim m As Integer, id As String
Dim l As Long, dictionary As Object, i As Long, t As Long

'======================================
Label3.Caption = ""
Label13.Caption = ""
Label5.Caption = ""
ListBox1.Clear
Label7.Caption = ""
Label9.Caption = ""
TextBox2.Value = ""
Label11.Caption = ""
Label15.Caption = ""
Label17.Caption = ""
Label19.Caption = ""
Label26.Caption = ""
OptionButton3.Value = False
OptionButton2.Value = False
OptionButton1.Value = False
'======================================

'--------------------------------------------
If Not Me.TextBox1.Value <> "" Then Exit Sub
'--------------------------------------------
Set dictionary = CreateObject("scripting.dictionary")

    Me.ListBox1.Clear
    For t = 3 To 34
    On Error Resume Next
        Me.Controls("TextBox" & t).Value = ""
    Next t
    On Error GoTo 0
    id = Me.TextBox1.Value
    m = 0
        Do While Sheet3.Cells(m + 1, 1) <> ""
            If Sheet3.Cells(m + 1, 1).Value = id Then
                Me.Label3.Caption = Sheet3.Cells(m + 1, 2)
                Me.Label5.Caption = Sheet3.Cells(m + 1, 3)
                Me.Label7.Caption = Sheet3.Cells(m + 1, 4)
                Me.Label9.Caption = Sheet3.Cells(m + 1, 5)
                Me.Label11.Caption = Sheet3.Cells(m + 1, 6)
                Me.Label13.Caption = Sheet3.Cells(m + 1, 7)
                Me.Label15.Caption = Sheet3.Cells(m + 1, 8)
                Me.Label17.Caption = Sheet3.Cells(m + 1, 9)
                Me.Label19.Caption = Sheet3.Cells(m + 1, 10)
                Me.Label26.Caption = Sheet3.Cells(m + 1, 11)
                l = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
                On Error Resume Next
                    If l < 2 Then l = 2
                        For i = 2 To l
                            If Sheet1.Cells(i, 2) = id Then
                                dictionary.Add Sheet1.Cells(i, 18).Value, 1
                            End If
                        Next
                        Me.ListBox1.List = dictionary.keys
            End If
            m = m + 1
        Loop
Set dictionary = Nothing
End Sub


Private Sub CommandButton1_Click()
Dim c As Long, t As Long, ct As Control
Dim id  As Variant, f As Range, l As Long, r As Range
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Database")
l = Sheet1.Cells(Rows.Count, "B").End(xlUp).Row
If Me.ListBox1.ListIndex >= 0 Then
    id = Me.ListBox1.Value
    Set f = Sheet1.Range("R2:R" & l)
    Set r = f.Find(TimeValue(id), LookIn:=xlFormulas)
    c = r.Row
Else
    c = l + 1
End If
With Sheet1
    .Cells(c, 2).Value = Me.TextBox1.Value
    .Cells(c, 3).Value = Me.Label3.Caption
    .Cells(c, 4).Value = Me.Label5.Caption
    .Cells(c, 5).Value = Me.Label7.Caption
    .Cells(c, 6).Value = Me.Label9.Caption
    .Cells(c, 7).Value = Me.Label11.Caption
    .Cells(c, 8).Value = Me.Label13.Caption
    .Cells(c, 9).Value = Me.Label15.Caption
    .Cells(c, 10).Value = Me.Label17.Caption
    .Cells(c, 11).Value = Me.Label19.Caption
    .Cells(c, 13).Value = Me.Label26.Caption
    .Cells(c, 16).Value = Me.TextBox2.Value
    .Cells(c, 17).Value = Me.TextBox3.Value
    .Cells(c, 18).Value = Now
   
If Me.OptionButton1.Value = True Then
    ws.Cells(c, 15) = Me.OptionButton1.Caption
End If

If Me.OptionButton2.Value = True Then
    ws.Cells(c, 15) = Me.OptionButton2.Caption
End If

If Me.OptionButton3.Value = True Then
    ws.Cells(c, 15) = Me.OptionButton3.Caption
End If

End With
For Each ct In Me.Controls
    If TypeName(ct) = "TextBox" Then
        ct.Value = ""
    End If
Next
Me.TextBox1.SetFocus
End Sub

Private Sub CommandButton2_Click()
Dim c, m, l As Long, id As Variant, r, f As Range
l = Sheet1.Cells(Rows.Count, "B").End(xlUp).Row
m = Val(Me.TextBox1.Value)
If IsError(Application.Match(m, Sheet1.Range("B2:B" & l), 0)) Then
    MsgBox "Pls enter a valid ID"
    Exit Sub
End If

id = Me.ListBox1.Value

If Me.ListBox1.ListIndex < 0 Then
    MsgBox "Pls select a date"
    Exit Sub
End If

Set f = Sheet1.Range("R2:R" & l)
Set r = f.Find(TimeValue(id), LookIn:=xlFormulas)
c = r.Row
With Me
    .Label3.Caption = Cells(c, 3)
    .Label5.Caption = Cells(c, 4)
    .Label7.Caption = Cells(c, 5)
    .Label9.Caption = Cells(c, 6)
    .Label11.Caption = Cells(c, 7)
    .Label13.Caption = Cells(c, 8)
    .Label15.Caption = Cells(c, 9)
    .Label17.Caption = Cells(c, 10)
    .Label19.Caption = Cells(c, 11)
    .Label26.Caption = Cells(c, 13)
    .TextBox2.Value = Cells(c, 16)
    .TextBox3.Value = Cells(c, 17)
End With
L0:
Set r = Nothing
Set f = Nothing
End Sub
[\CODE]

Thanks!
 
Change this...

Code: 
Private Sub CommandButton2_Click()
Dim c, m, l As Long, id As Variant, r, f As Range
l = Sheet1.Cells(Rows.Count, "B").End(xlUp).Row
m = Me.TextBox1.Value
 
You must log in or register to reply here.
Back
Top