coding a textbox to search in the worksheet

C

castellano

New Member
Joined
May 28, 2009
Messages
20
How i can encode a textbox on my userform to locate and bring all the data in the same row to the respective fields in the userform. I am working in excel 2003 vba. If you need more imformation reply me.
wink.gif
 

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.
Sort by date Sort by votes
hi i have some question of how to adapt this to my form here is the code and image so , you that understand better can help me please, only left find button to search by administer personel
frown.gif
:I not know how to post the image of my form.
first button = CommandButton1
Previous button = CommandButton2
Next button = CommandButton3
Last button = CommandButton4
save button = CommandButton5
cancel button = CommandButton6
add = CommandButton7
Code: 
Private Sub ANN__Change()
EnableSave
End Sub
Private Sub ANN_Change()
EnableSave
End Sub
Private Sub C_S_Change()
EnableSave
End Sub
Private Sub CLOSE_OUT_Change()
EnableSave
End Sub
Private Sub CommandButton5_Click()
DisableSave
ThisWorkbook.Save
PutData
     
End Sub
Private Sub CommandButton8_Click()
Dim strFind As String    'what to find
    Dim FirstAddress As String
    Dim rSearch As Range  'range to search
    Set rSearch = Sheet1.Range("a7", Range("a65536").End(xlUp))
    Dim f      As Integer
    imgFolder = ThisWorkbook.Path & Application.PathSeparator & "images" & Application.PathSeparator
    strFind = Me.ADM_PERSONNEL.Text    'what to look for
    With rSearch
        Set c = .Find(strFind, LookIn:=xlValues)
        If Not c Is Nothing Then    'found it
            c.Select
            With Me    'load entry to form
                .ADM_PERSONNEL.Text = c.Offset(0, 1).Text
                .ADM_TITLE.Text = c.Offset(0, 2).Text
                .PI_PD_NAME.Text = c.Offset(0, 3).Text
                .UNIT.Text = c.Offset(0, 4).Text
                .AGENCY.Text = c.Offset(0, 5).Text
                .FILE_NO.Text = c.Offset(0, 6).Text
                .PROJECT_TITLE.Text = c.Offset(0, 7).Text
                .START_DATE.Text = c.Offset(0, 8).Text
                .END_DATE.Text = c.Offset(0, 9).Text
                .MONTH.Text = c.Offset(0, 10).Text
                .DAY.Text = c.Offset(0, 11).Text
                .P_T.Value = c.Offset(0, 12).Value
                .S_A.Value = c.Offset(0, 13).Value
                .ANN.Value = c.Offset(0, 14).Value
                .FIN.Value = c.Offset(0, 15).Value
                .P_T_.Value = c.Offset(0, 16).Value
                .S_A_.Value = c.Offset(0, 17).Value
                .ANN_.Value = c.Offset(0, 18).Value
                .FIN_.Value = c.Offset(0, 19).Value
                .CLOSE_OUT.Value = c.Offset(0, 20).Value
                .C_S.Value = c.Offset(0, 21).Value
                
                
                
                .CommandButton5.Enabled = True     'allow save or
                .CommandButton6.Enabled = True    'allow record deletion
                .CommandButton7.Enabled = False      'don't want to duplicate record
        
                f = 0
            End With
            FirstAddress = c.Address
            Do
                f = f + 1    'count number of matching records
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> FirstAddress
            If f > 1 Then
                Select Case MsgBox("There are " & f & " instances of " & strFind, vbOKCancel Or vbExclamation Or vbDefaultButton1, "Multiple entries")
                    Case vbOK
                        FindAll
                    Case vbCancel
                        'do nothing
                End Select
                Me.Height = frmMax
            End If
        Else: MsgBox strFind & " not listed"    'search failed
        End If
    End With
    If Sheet1.AutoFilterMode Then Sheet1.Range("A7").AutoFilter
End Sub
Private Sub FILE_NO_Change()
EnableSave
End Sub
Private Sub FIN__Change()
EnableSave
End Sub
Private Sub FIN_Change()
EnableSave
End Sub
Private Sub ListBox1_Click()
   If Me.ListBox1.ListIndex = -1 Then    'not selected
        MsgBox " No selection made"
    ElseIf Me.ListBox1.ListIndex >= 1 Then    'User has selected
        r = Me.ListBox1.ListIndex
        With Me
            .ADM_PERSONNEL.Text = ListBox1.List(r, 0)
            .ADM_TITLE.Text = ListBox1.List(r, 1)
            .PI_PD_NAME.Text = ListBox1.List(r, 2)
            .UNIT.Text = ListBox1.List(r, 3)
            .AGENCY.Text = Cells(r, 5)
            .FILE_NO.Text = ListBox1.List(r, 6)
            .PROJECT_TITLE.Text = ListBox1.List(r, 7)
            .START_DATE.Text = ListBox1.List(r, 8)
            .END_DATE.Text = ListBox1.List(r, 9)
            .MONTH.Text = ListBox1.List(r, 10)
            .DAY.Text = ListBox1.List(r, 11)
            .P_T.Value = ListBox1.List(r, 12)
            .S_A.Value = ListBox1.List(r, 13)
            .ANN.Value = ListBox1.List(r, 14)
            .FIN.Value = ListBox1.List(r, 15)
            .P_T_.Value = ListBox1.List(r, 16)
            .S_A_.Value = ListBox1.List(r, 17)
            .ANN_.Value = ListBox1.List(r, 18)
            .FIN_.Value = ListBox1.List(r, 19)
            .CLOSE_OUT.Value = ListBox1.List(r, 20)
            .C_S.Value = ListBox1.List(r, 21)
            .CommandButton5.Enabled = True      'allow save the record
            .CommandButton6.Enabled = True      'allow cancel the input
            .CommandButton7.Enabled = False       'don't want duplicate
        End With
    End If
End Sub
Sub FindAll()
    Dim strFind As String    'what to find
    Dim rFilter As Range     'range to search
    Set rFilter = Sheet1.Range("a7", Range("d65536").End(xlUp))
    Set rng = Sheet1.Range("a6", Range("a65536").End(xlUp))
    strFind = Me.ADM_PERSONNEL.Text
    With Sheet1
        If Not .AutoFilterMode Then .Range("A8").AutoFilter
        rFilter.AutoFilter Field:=1, Criteria1:=strFind
        Set rng = rng.Cells.SpecialCells(xlCellTypeVisible)
        Me.ListBox1.Clear
        For Each c In rng
            With Me.ListBox1
                .AddItem c.Value
                .List(.ListCount - 1, 1) = c.Offset(0, 1).Text
                .List(.ListCount - 1, 2) = c.Offset(0, 2).Text
                .List(.ListCount - 1, 3) = c.Offset(0, 3).Text
                .List(.ListCount - 1, 4) = c.Offset(0, 4).Text
                .List(.ListCount - 1, 5) = c.Offset(0, 5).Text
                .List(.ListCount - 1, 6) = c.Offset(0, 6).Text
                .List(.ListCount - 1, 7) = c.Offset(0, 7).Text
                .List(.ListCount - 1, 8) = c.Offset(0, 8).Text
                .List(.ListCount - 1, 9) = c.Offset(0, 9).Text
                .List(.ListCount - 1, 10) = c.Offset(0, 10).Text
                .List(.ListCount - 1, 11) = c.Offset(0, 11).Value
                .List(.ListCount - 1, 12) = c.Offset(0, 12).Value
                .List(.ListCount - 1, 13) = c.Offset(0, 13).Value
                .List(.ListCount - 1, 14) = c.Offset(0, 14).Value
                .List(.ListCount - 1, 15) = c.Offset(0, 15).Value
                .List(.ListCount - 1, 16) = c.Offset(0, 16).Value
                .List(.ListCount - 1, 17) = c.Offset(0, 17).Value
                .List(.ListCount - 1, 18) = c.Offset(0, 18).Value
                .List(.ListCount - 1, 19) = c.Offset(0, 19).Value
                .List(.ListCount - 1, 20) = c.Offset(0, 20).Value
                .List(.ListCount - 1, 21) = c.Offset(0, 21).Value
                    
            End With
        Next c
    End With
End Sub
Private Sub P_T__Change()
EnableSave
End Sub
Private Sub P_T_Change()
EnableSave
End Sub
Private Sub S_A__Change()
EnableSave
End Sub
Private Sub S_A_Change()
EnableSave
End Sub
Private Sub UserForm_Initialize()
GetData
PutData
Dim LastRow As Object

End Sub
Private Sub GetData()
LastRow = 120
Dim r As Long
If IsNumeric(RowNumber.Text) Then
    r = CLng(RowNumber.Text)
    
   
Else
    ClearData
    MsgBox "Illegal row number"
    Exit Sub
    
End If
If r > 1 And r <= LastRow Then
    ADM_PERSONNEL.Text = Cells(r, 1)
    ADM_TITLE.Text = Cells(r, 2)
    PI_PD_NAME.Text = Cells(r, 3)
    UNIT.Text = Cells(r, 4)
    AGENCY.Text = Cells(r, 5)
    FILE_NO.Text = Cells(r, 6)
    PROJECT_TITLE.Text = Cells(r, 7)
    START_DATE.Text = Cells(r, 8)
    END_DATE.Text = Cells(r, 9)
    MONTH.Text = Cells(r, 10)
    DAY.Text = Cells(r, 11)
    P_T.Value = Cells(r, 12)
    S_A.Value = Cells(r, 13)
    ANN.Value = Cells(r, 14)
    FIN.Value = Cells(r, 15)
    P_T_.Value = Cells(r, 16)
    S_A_.Value = Cells(r, 17)
    ANN_.Value = Cells(r, 18)
    FIN_.Value = Cells(r, 19)
    CLOSE_OUT.Value = Cells(r, 20)
    C_S.Value = Cells(r, 21)
    
    DisableSave
    
ElseIf r = 1 Then
    ClearData
Else
    ClearData
    MsgBox "this service is in contruction"
    
End If
End Sub
Private Sub PutData()
LastRow = 120
Dim r As Long
If IsNumeric(RowNumber.Text) Then
        r = CLng(RowNumber.Text)
        
Else
        MsgBox "Illegal row number"
        Exit Sub
        
End If
If r > 1 And r < LastRow Then
        Cells(r, 1) = ADM_PERSONNEL.Text
        Cells(r, 2) = ADM_TITLE.Text
        Cells(r, 3) = PI_PD_NAME.Text
        Cells(r, 4) = UNIT.Text
        Cells(r, 5) = AGENCY.Text
        Cells(r, 6) = FILE_NO.Text
        Cells(r, 7) = PROJECT_TITLE.Text
        Cells(r, 8) = START_DATE.Text
        Cells(r, 9) = END_DATE.Text
        Cells(r, 10) = MONTH.Text
        Cells(r, 11) = DAY.Text
        Cells(r, 12) = P_T.Value
        Cells(r, 13) = S_A.Value
        Cells(r, 14) = ANN.Value
        Cells(r, 15) = FIN.Value
        Cells(r, 16) = P_T_.Value
        Cells(r, 17) = S_A_.Value
        Cells(r, 18) = ANN_.Value
        Cells(r, 19) = FIN_.Value
        Cells(r, 20) = CLOSE_OUT.Value
        Cells(r, 21) = C_S.Value
 
        DisableSave
        
Else
        MsgBox "Problemas"
        
End If
End Sub
Private Sub ClearData()
ADM_PERSONNEL.Text = ""
ADM_TITLE.Text = ""
PI_PD_NAME.Text = ""
UNIT.Text = ""
AGENCY.Text = " "
FILE_NO.Text = " "
PROJECT_TITLE.Text = " "
START_DATE.Text = " "
END_DATE.Text = " "
MONTH.Text = " "
DAY.Text = " "
P_T.Value = False
S_A.Value = False
ANN.Value = False
FIN.Value = False
P_T_.Value = False
S_A_.Value = False
ANN_.Value = False
FIN_.Value = False
CLOSE_OUT.Value = False
C_S.Value = False
End Sub
Private Sub CommandButton1_Click()
RowNumber.Text = "7"
End Sub
Private Sub CommandButton6_Click()
DisableSave
GetData
      
End Sub
Private Sub CommandButton7_Click()
 Set LastRow = Sheet1.Range("a65536").End(xlUp)
 
 LastRow.Offset(1, 0).Value = ADM_PERSONNEL.Text
 LastRow.Offset(1, 1).Value = ADM_TITLE.Text
 LastRow.Offset(1, 2).Value = PI_PD_NAME.Text
 LastRow.Offset(1, 3).Value = UNIT.Text
 LastRow.Offset(1, 4).Value = AGENCY.Text
LastRow.Offset(1, 5).Value = FILE_NO.Text
LastRow.Offset(1, 6).Value = PROJECT_TITLE.Text
LastRow.Offset(1, 7).Value = START_DATE.Text
LastRow.Offset(1, 8).Value = END_DATE.Text
LastRow.Offset(1, 9).Value = MONTH.Text
LastRow.Offset(1, 10).Value = DAY.Text
LastRow.Offset(1, 12).Value = P_T.Value
LastRow.Offset(1, 13).Value = S_A.Value
LastRow.Offset(1, 14).Value = ANN.Value
LastRow.Offset(1, 15).Value = FIN.Value
LastRow.Offset(1, 16).Value = P_T_.Value
LastRow.Offset(1, 17).Value = S_A_.Value
LastRow.Offset(1, 18).Value = ANN_.Value
LastRow.Offset(1, 19).Value = FIN_.Value
LastRow.Offset(1, 20).Value = CLOSE_OUT.Value
LastRow.Offset(1, 21).Value = C_S.Value
MsgBox "One record written to Matriz1"
response = MsgBox("Do you want to enter another record?", _
              vbYesNo)
              
If response = vbYes Then
ADM_PERSONNEL.Text = ""
ADM_TITLE.Text = ""
PI_PD_NAME.Text = ""
UNIT.Text = ""
AGENCY.Text = " "
FILE_NO.Text = " "
PROJECT_TITLE.Text = " "
START_DATE.Text = " "
END_DATE.Text = " "
MONTH.Text = " "
DAY.Text = " "
P_T.Value = False
S_A.Value = False
ANN.Value = False
FIN.Value = False
P_T_.Value = False
S_A_.Value = False
ANN_.Value = False
FIN_.Value = False
CLOSE_OUT.Value = False
C_S.Value = False
ADM_PERSONNEL.SetFocus
Else
ThisWorkbook.Save
End If
End Sub
Private Sub DisableSave()
CommandButton5.Enabled = False
CommandButton6.Enabled = False
End Sub
Private Sub EnableSave()
CommandButton5.Enabled = True
CommandButton6.Enabled = True
End Sub
 
Private Sub CommandButton2_Click()
Dim idxPage As Integer
   idxPage = Me.RowNumber.Value - 1
   If idxPage = 3 Then idxPage = 0
   Me.RowNumber.Value = idxPage
End Sub
Private Sub CommandButton3_Click()
   Dim idxPage As Integer
   idxPage = Me.RowNumber.Value + 1
   If idxPage = 3 Then idxPage = 0
   Me.RowNumber.Value = idxPage
    
End Sub
Private Sub CommandButton4_Click()
LastRow = FindLastRow - 1
RowNumber.Text = FormatNumber(LastRow, 0)
End Sub
Private Function FindLastRow()
Dim r As Long
r = 7
Do While r < 65536 And Len(Cells(r, 1).Text) > 0
    r = r + 1
    
Loop
FindLastRow = r
End Function
Private Sub RowNumber_Change()
GetData
End Sub
Private Sub ADM_PERSONNEL_Change()
EnableSave
End Sub
Private Sub ADM_TITLE_Change()
EnableSave
End Sub
Private Sub AGENCY_Change()
EnableSave
End Sub

Private Sub DAY_Change()
EnableSave
End Sub
Private Sub END_DATE_Change()
EnableSave
End Sub
Private Sub MONTH_Change()
EnableSave
End Sub
Private Sub PI_PD_NAME_Change()
EnableSave
End Sub
Private Sub PROJECT_TITLE_Change()
EnableSave
End Sub
Private Sub START_DATE_Change()
EnableSave
End Sub
Private Sub UNIT_Change()
EnableSave
End Sub
 
Upvote 0
I looked at your post and code as requested. You posted too much detail code to wade through to find something about your vague request. The Queen Mary II could cross the Atlantic before I could find anything near what you may be asking. Please boil the code posted down to pertinent information and expand your request to exactly what your looking for.
 
Upvote 0
sorry i try to create a button that when i type something in a textbox and press the find button he populated all the fields in that row in the userform respective textboxes.
 
Upvote 0
I think this is what your looking for. Replace control names to your names.
Code: 
Option Explicit
Private Sub CommandButton10_Click()
    Dim row As Long
    Dim LookUpRange As Range
    If TextBox1 = "" Then
        MsgBox "Please enter a search item in textbox1."
        Exit Sub
    End If
    With Sheets("Sheet1")
        Set LookUpRange = .Range("A1", .Range("A65536").End(xlUp))
        On Error Resume Next
        row = LookUpRange.Find(TextBox1, LookIn:=xlValues, lookat:=xlWhole).row
        If row = 0 Then
            MsgBox "Sorry, " & TextBox1 & " not found."
            Exit Sub
        Else
            TextBox2 = .Cells(row, 2)
            'more textboxes to fill
            '
            '
            '
            '
        End If
    End With
End Sub
 
Upvote 0
I try the code but give a error i highligth the error "subcript out of range". I have a listbox that i whant to coding because one administer personnel can have 2 o more project:
Code: 
Private Sub CommandButton8_Click()
Dim row As Long
    Dim LookUpRange As Range
    If ADM_PERSONNEL = "" Then
        MsgBox "Please enter a search item in ADM_PERSONNEL."
        Exit Sub
    End If
    [COLOR=yellow]With Sheets("Sheet1")
[/COLOR]        Set LookUpRange = .Range("A7", .Range("A65536").End(xlUp))
        On Error Resume Next
        row = LookUpRange.Find(ADM_PERSONNEL, LookIn:=xlValues, lookat:=xlWhole).row
        If row = 0 Then
            MsgBox "Sorry, " & ADM_PERSONNEL & " not found."
            Exit Sub
        Else
    ADM_TITLE.Text = Cells(r, 2)
    PI_PD_NAME.Text = Cells(r, 3)
    UNIT.Text = Cells(r, 4)
    AGENCY.Text = Cells(r, 5)
    FILE_NO.Text = Cells(r, 6)
    PROJECT_TITLE.Text = Cells(r, 7)
    START_DATE.Text = Cells(r, 8)
    END_DATE.Text = Cells(r, 9)
    MONTH.Text = Cells(r, 10)
    DAY.Text = Cells(r, 11)
    P_T.Value = Cells(r, 12)
    S_A.Value = Cells(r, 13)
    ANN.Value = Cells(r, 14)
    FIN.Value = Cells(r, 15)
    P_T_.Value = Cells(r, 16)
    S_A_.Value = Cells(r, 17)
    ANN_.Value = Cells(r, 18)
    FIN_.Value = Cells(r, 19)
    CLOSE_OUT.Value = Cells(r, 20)
    C_S.Value = Cells(r, 21)
End If
    End With
End Sub
 
Upvote 0
Hi,

Do you have a Sheet1?
Should this...

Code: 
[COLOR=#ffff00]With Sheets("Sheet1")[/COLOR]

Be..

Code: 
With Sheets("Matriz1")

Ak
 
Upvote 0
You must log in or register to reply here.

Similar threads

I
  • Solved
Code not formatting correctly in textbox userform
2 3
Replies
22
Views
203
MARK858
MARK858
I
  • Question
Add button to increment textbox value by 1
2
Replies
13
Views
155
Artik
Artik
I
  • Question
Textbox wont allow set focus on it after trying to clear textboxes
2
Replies
13
Views
151
ipbr21054
I
F
  • Question
Userform textbox launches another userform
Replies
8
Views
517
FedElecQaEng
F
I
  • Question
Code runs out of line & edit advice needed please
Replies
2
Views
171
Micron
M

Forum statistics

Threads
1,216,514
Messages
6,131,105
Members
449,619
Latest member
AntoineMaubon

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top