Bob Blooms
11-30-2009, 07:15 PM
It appears what I thought was straight forward is not so. My project is to allow the user to update a personnel database employing a userform.
The form provides a search capability on the last name. The code counts multiple entries with the same last name. When the Find All command button is clicked the data is listed in a listbox. The user then selects the desired record, the 22 data elements are transferred to the appropriate textboxes. The problem is only half of the data elements are transferred.
This is results from having "commenting" (putting an ' in front of the code) for half of the textbox inputs. When all code is available in Sub cmbFindAll_Click() VBA crashes where I have inserted the first '.
Please help. :banghead: I am new at VBA :dunno
The code I'm using is as follows:
Option Explicit
Dim MyArray(1000, 23)
Public MyData As Range, c As Range
Dim rFound As Range
Dim r As Long
Dim rng As Range
' Sets size of userform
Const frmMax As Long = 500
Const frmHt As Long = 500
Private Sub cmbAdd_Click()
' This routine responses to the Add button click
' Find the next blank row at the end of column A
Set c = Range("a65536").End(xlUp).Offset(1, 0)
' Stop flashing screen as routine is being processed
Application.ScreenUpdating = False
' Write textbox entries in userform to new line at end of database
c.Value = Me.TextBox1.Value
c.Offset(0, 1).Value = Me.TextBox2.Value
c.Offset(0, 2).Value = Me.TextBox3.Value
c.Offset(0, 3).Value = Me.TextBox4.Value
c.Offset(0, 4).Value = Me.TextBox5.Value
c.Offset(0, 5).Value = Me.TextBox6.Value
c.Offset(0, 6).Value = Me.TextBox7.Value
c.Offset(0, 7).Value = Me.TextBox8.Value
c.Offset(0, 8).Value = Me.TextBox9.Value
c.Offset(0, 9).Value = Me.TextBox10.Value
c.Offset(0, 10).Value = Me.ComboBox1.Value
c.Offset(0, 11).Value = Me.TextBox12.Value
c.Offset(0, 12).Value = Me.TextBox13.Value
c.Offset(0, 13).Value = Me.TextBox14.Value
c.Offset(0, 14).Value = Me.TextBox15.Value
c.Offset(0, 15).Value = Me.TextBox16.Value
c.Offset(0, 16).Value = Me.TextBox17.Value
c.Offset(0, 17).Value = Me.TextBox18.Value
c.Offset(0, 18).Value = Me.TextBox19.Value
c.Offset(0, 19).Value = Me.TextBox20.Value
c.Offset(0, 20).Value = Me.TextBox21.Value
c.Offset(0, 21).Value = Me.TextBox22.Value
' Clear the userform
With Me
.TextBox1.Value = vbNullString
.TextBox2.Value = vbNullString
.TextBox3.Value = vbNullString
.TextBox4.Value = vbNullString
.TextBox5.Value = vbNullString
.TextBox6.Value = vbNullString
.TextBox7.Value = vbNullString
.TextBox8.Value = vbNullString
.TextBox9.Value = vbNullString
.TextBox10.Value = vbNullString
.ComboBox1.Value = vbNullString
.TextBox12.Value = vbNullString
.TextBox13.Value = vbNullString
.TextBox14.Value = vbNullString
.TextBox15.Value = vbNullString
.TextBox16.Value = vbNullString
.TextBox17.Value = vbNullString
.TextBox18.Value = vbNullString
.TextBox19.Value = vbNullString
.TextBox20.Value = vbNullString
.TextBox21.Value = vbNullString
.TextBox22.Value = vbNullString
End With
' Restores automatic updating of screen even as routine is being processed
Application.ScreenUpdating = True
End Sub
Private Sub cmbCancel_Click()
' Clears and closes userform and returns to database
With Me
.TextBox1.Value = vbNullString
.TextBox2.Value = vbNullString
.TextBox3.Value = vbNullString
.TextBox4.Value = vbNullString
.TextBox5.Value = vbNullString
.TextBox6.Value = vbNullString
.TextBox7.Value = vbNullString
.TextBox8.Value = vbNullString
.TextBox9.Value = vbNullString
.TextBox10.Value = vbNullString
.ComboBox1.Value = vbNullString
.TextBox12.Value = vbNullString
.TextBox13.Value = vbNullString
.TextBox14.Value = vbNullString
.TextBox15.Value = vbNullString
.TextBox16.Value = vbNullString
.TextBox17.Value = vbNullString
.TextBox18.Value = vbNullString
.TextBox19.Value = vbNullString
.TextBox20.Value = vbNullString
.TextBox21.Value = vbNullString
.TextBox22.Value = vbNullString
.ListBox1.Clear
End With
frmMain.Hide
Selection.AutoFilter Field:=1
Range("A4").Select
Application.ScreenUpdating = True
On Error GoTo 0
End Sub
Private Sub cmbClear_Click()
' Clears userform
With Me
.TextBox1.Value = vbNullString
.TextBox2.Value = vbNullString
.TextBox3.Value = vbNullString
.TextBox4.Value = vbNullString
.TextBox5.Value = vbNullString
.TextBox6.Value = vbNullString
.TextBox7.Value = vbNullString
.TextBox8.Value = vbNullString
.TextBox9.Value = vbNullString
.TextBox10.Value = vbNullString
.ComboBox1.Value = vbNullString
.TextBox12.Value = vbNullString
.TextBox13.Value = vbNullString
.TextBox14.Value = vbNullString
.TextBox15.Value = vbNullString
.TextBox16.Value = vbNullString
.TextBox17.Value = vbNullString
.TextBox18.Value = vbNullString
.TextBox19.Value = vbNullString
.TextBox20.Value = vbNullString
.TextBox21.Value = vbNullString
.TextBox22.Value = vbNullString
.ListBox1.Clear
.cmbAmend.Enabled = False
.cmbDelete.Enabled = False
.cmbAdd.Enabled = True
End With
Selection.AutoFilter Field:=1
Range("A4").Select
End Sub
Private Sub cmbDelete_Click()
' This routine is a response to the Delete button being clicked.
Dim msgResponse As String
' Stop flashing screen as routine is being processed
Application.ScreenUpdating = False
' Verify that the user wants to delete record shown in userform
msgResponse = MsgBox("This will delete the selected record. Continue?", _
vbCritical + vbYesNo, "Delete Record")
' Response based on answer clicked in message box
Select Case msgResponse
' If "Yes" button is selected
Case vbYes
' The value c has been selected by the Find button
Set c = ActiveCell
' This deletes record selected by the Find button
c.EntireRow.Delete
' This sets the Amend, Delete, and Add buttons
With Me
.cmbAmend.Enabled = False 'prevent accidental use
.cmbDelete.Enabled = False 'prevent accidental use
.cmbAdd.Enabled = True 'restore use
'
' Clear userform
.TextBox1.Value = vbNullString
.TextBox2.Value = vbNullString
.TextBox3.Value = vbNullString
.TextBox4.Value = vbNullString
.TextBox5.Value = vbNullString
.TextBox6.Value = vbNullString
.TextBox7.Value = vbNullString
.TextBox8.Value = vbNullString
.TextBox9.Value = vbNullString
.TextBox10.Value = vbNullString
.ComboBox1.Value = vbNullString
.TextBox12.Value = vbNullString
.TextBox13.Value = vbNullString
.TextBox14.Value = vbNullString
.TextBox15.Value = vbNullString
.TextBox16.Value = vbNullString
.TextBox17.Value = vbNullString
.TextBox18.Value = vbNullString
.TextBox19.Value = vbNullString
.TextBox20.Value = vbNullString
.TextBox21.Value = vbNullString
.TextBox22.Value = vbNullString
End With
' If "No" button is clicked delete action is cancelled
Case vbNo
Exit Sub
End Select
' Restores automatic updating of screen even as routine is being processed
Application.ScreenUpdating = True
End Sub
Private Sub cmbFind_Click()
' This routine searches for records based on user input
Dim strFind, LastName As String 'what to find
Dim rSearch As Range 'range to search
Dim f As Integer
Set rSearch = Sheet3.Range("a3", Range("a65536").End(xlUp))
strFind = Me.TextBox1.Value '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
.TextBox2.Value = c.Offset(0, 1).Value
.TextBox3.Value = c.Offset(0, 2).Value
.TextBox4.Value = c.Offset(0, 3).Value
.TextBox5.Value = c.Offset(0, 4).Value
.TextBox6.Value = c.Offset(0, 5).Value
.TextBox7.Value = c.Offset(0, 6).Value
.TextBox8.Value = c.Offset(0, 7).Value
.TextBox9.Value = c.Offset(0, 8).Value
.TextBox10.Value = c.Offset(0, 9).Value
.ComboBox1.Value = c.Offset(0, 10).Value
.TextBox12.Value = c.Offset(0, 11).Value
.TextBox13.Value = c.Offset(0, 12).Value
.TextBox14.Value = c.Offset(0, 13).Value
.TextBox15.Value = c.Offset(0, 14).Value
.TextBox16.Value = c.Offset(0, 15).Value
.TextBox17.Value = c.Offset(0, 16).Value
.TextBox18.Value = c.Offset(0, 17).Value
.TextBox19.Value = c.Offset(0, 18).Value
.TextBox20.Value = c.Offset(0, 19).Value
.TextBox21.Value = c.Offset(0, 20).Value
.TextBox22.Value = c.Offset(0, 21).Value
' This resets the Amend, Delete, and Add buttons
.cmbAmend.Enabled = True 'allow amendment or
.cmbDelete.Enabled = True 'allow record deletion
.cmbAdd.Enabled = False 'don't allow duplicate record
f = 0
End With
LastName = c.Address
Do
f = f + 1 'count number of matching records
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> LastName
If f > 1 Then
MsgBox "There are " & f & " instances of " & strFind
Me.Height = frmMax
End If
Else: MsgBox strFind & " not listed" 'search found no matches
End If
End With
End Sub
Private Sub cmbAmend_Click()
Application.ScreenUpdating = False
If rng Is Nothing Then GoTo skip
For Each c In rng
If r = 0 Then c.Select
r = r - 1
Next c
skip:
Set c = ActiveCell
c.Value = Me.TextBox1.Value ' write amendments to database
c.Offset(0, 1).Value = Me.TextBox2.Value
c.Offset(0, 2).Value = Me.TextBox3.Value
c.Offset(0, 3).Value = Me.TextBox4.Value
c.Offset(0, 4).Value = Me.TextBox5.Value
c.Offset(0, 5).Value = Me.TextBox6.Value
c.Offset(0, 6).Value = Me.TextBox7.Value
c.Offset(0, 7).Value = Me.TextBox8.Value
c.Offset(0, 8).Value = Me.TextBox9.Value
c.Offset(0, 9).Value = Me.TextBox10.Value
c.Offset(0, 10).Value = Me.ComboBox1.Value
c.Offset(0, 11).Value = Me.TextBox12.Value
c.Offset(0, 12).Value = Me.TextBox13.Value
c.Offset(0, 13).Value = Me.TextBox14.Value
c.Offset(0, 14).Value = Me.TextBox15.Value
c.Offset(0, 15).Value = Me.TextBox16.Value
c.Offset(0, 16).Value = Me.TextBox17.Value
c.Offset(0, 17).Value = Me.TextBox18.Value
c.Offset(0, 18).Value = Me.TextBox19.Value
c.Offset(0, 19).Value = Me.TextBox20.Value
c.Offset(0, 20).Value = Me.TextBox21.Value
c.Offset(0, 21).Value = Me.TextBox22.Value
'Clear userform and restore buttons
With Me
.TextBox1.Value = vbNullString
.TextBox2.Value = vbNullString
.TextBox3.Value = vbNullString
.TextBox4.Value = vbNullString
.TextBox5.Value = vbNullString
.TextBox6.Value = vbNullString
.TextBox7.Value = vbNullString
.TextBox8.Value = vbNullString
.TextBox9.Value = vbNullString
.TextBox10.Value = vbNullString
.ComboBox1.Value = vbNullString
.TextBox12.Value = vbNullString
.TextBox13.Value = vbNullString
.TextBox14.Value = vbNullString
.TextBox15.Value = vbNullString
.TextBox16.Value = vbNullString
.TextBox17.Value = vbNullString
.TextBox18.Value = vbNullString
.TextBox19.Value = vbNullString
.TextBox20.Value = vbNullString
.TextBox21.Value = vbNullString
.TextBox22.Value = vbNullString
.cmbAmend.Enabled = False
.cmbDelete.Enabled = False
.cmbAdd.Enabled = True
.Height = frmHt
End With
If Sheet3.AutoFilterMode Then Sheet3.ShowAllData
Application.ScreenUpdating = True
On Error GoTo 0
End Sub
Sub cmbFindAll_Click()
Dim strFind As String 'what to find
Dim rFilter As Range 'range to search
Set rFilter = Sheet3.Range("a3", Range("v65536").End(xlUp))
Set rng = Sheet3.Range("a4", Range("a65536").End(xlUp))
strFind = Me.TextBox1.Value
With Sheet3
If Not .AutoFilterMode Then .Range("A3").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).Value
.List(.ListCount - 1, 2) = c.Offset(0, 2).Value
.List(.ListCount - 1, 3) = c.Offset(0, 3).Value
.List(.ListCount - 1, 4) = c.Offset(0, 4).Value
.List(.ListCount - 1, 5) = c.Offset(0, 5).Value
.List(.ListCount - 1, 6) = c.Offset(0, 6).Value
.List(.ListCount - 1, 7) = c.Offset(0, 7).Value
.List(.ListCount - 1, 8) = c.Offset(0, 8).Value
.List(.ListCount - 1, 9) = c.Offset(0, 9).Value
'.List(.ListCount - 1, 10) = c.Offset(0, 10).Value
'.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 cmbLast_Click()
Dim LastCl As Range
Set LastCl = Range("a65536").End(xlUp) 'last used cell in column A
With Me
.cmbAmend.Enabled = False
.cmbDelete.Enabled = False
.cmbAdd.Enabled = True
.TextBox1.Value = LastCl.Value
.TextBox2.Value = LastCl.Offset(0, 1).Value
.TextBox3.Value = LastCl.Offset(0, 2).Value
.TextBox4.Value = LastCl.Offset(0, 3).Value
.TextBox5.Value = LastCl.Offset(0, 4).Value
.TextBox6.Value = LastCl.Offset(0, 5).Value
.TextBox7.Value = LastCl.Offset(0, 6).Value
.TextBox8.Value = LastCl.Offset(0, 7).Value
.TextBox9.Value = LastCl.Offset(0, 8).Value
.TextBox10.Value = LastCl.Offset(0, 9).Value
.ComboBox1.Value = LastCl.Offset(0, 10).Value
.TextBox12.Value = LastCl.Offset(0, 11).Value
.TextBox13.Value = LastCl.Offset(0, 12).Value
.TextBox14.Value = LastCl.Offset(0, 13).Value
.TextBox15.Value = LastCl.Offset(0, 14).Value
.TextBox16.Value = LastCl.Offset(0, 15).Value
.TextBox17.Value = LastCl.Offset(0, 16).Value
.TextBox18.Value = LastCl.Offset(0, 17).Value
.TextBox19.Value = LastCl.Offset(0, 18).Value
.TextBox20.Value = LastCl.Offset(0, 19).Value
.TextBox21.Value = LastCl.Offset(0, 20).Value
.TextBox22.Value = LastCl.Offset(0, 21).Value
End With
End Sub
Private Sub cmbSelect_Click()
If Me.ListBox1.ListIndex = -1 Then 'not selected
MsgBox " No selection made"
ElseIf Me.ListBox1.ListIndex >= 0 Then 'User has selected
r = Me.ListBox1.ListIndex
MsgBox (r)
With Me
.TextBox1.Value = ListBox1.List(r, 0)
.TextBox2.Value = ListBox1.List(r, 1)
.TextBox3.Value = ListBox1.List(r, 2)
.TextBox4.Value = ListBox1.List(r, 3)
.TextBox5.Value = ListBox1.List(r, 4)
.TextBox6.Value = ListBox1.List(r, 5)
.TextBox7.Value = ListBox1.List(r, 6)
.TextBox8.Value = ListBox1.List(r, 7)
.TextBox9.Value = ListBox1.List(r, 8)
.TextBox10.Value = ListBox1.List(r, 9)
'.ComboBox1.Value = ListBox1.List(r, 10)
'.TextBox12.Value = ListBox1.List(r, 11)
'.TextBox13.Value = ListBox1.List(r, 12)
'.TextBox14.Value = ListBox1.List(r, 13)
'.TextBox15.Value = ListBox1.List(r, 14)
'.TextBox16.Value = ListBox1.List(r, 15)
'.TextBox17.Value = ListBox1.List(r, 16)
'.TextBox18.Value = ListBox1.List(r, 17)
'.TextBox19.Value = ListBox1.List(r, 18)
'.TextBox20.Value = ListBox1.List(r, 19)
'.TextBox21.Value = ListBox1.List(r, 20)
'.TextBox22.Value = ListBox1.List(r, 21)
.cmbAmend.Enabled = True 'allow amendment or
.cmbDelete.Enabled = True 'allow record deletion
.cmbAdd.Enabled = False 'don't want duplicate
End With
End If
End Sub
Private Sub UserForm_Deactivate()
Sheet3.ShowAllData
End Sub
Private Sub UserForm_Initialize()
Set MyData = Sheet3.Range("a3").CurrentRegion
With Me
.Caption = "Judicial Employee Management Information System" 'userform caption
.Height = frmHt
End With
End Sub
The form provides a search capability on the last name. The code counts multiple entries with the same last name. When the Find All command button is clicked the data is listed in a listbox. The user then selects the desired record, the 22 data elements are transferred to the appropriate textboxes. The problem is only half of the data elements are transferred.
This is results from having "commenting" (putting an ' in front of the code) for half of the textbox inputs. When all code is available in Sub cmbFindAll_Click() VBA crashes where I have inserted the first '.
Please help. :banghead: I am new at VBA :dunno
The code I'm using is as follows:
Option Explicit
Dim MyArray(1000, 23)
Public MyData As Range, c As Range
Dim rFound As Range
Dim r As Long
Dim rng As Range
' Sets size of userform
Const frmMax As Long = 500
Const frmHt As Long = 500
Private Sub cmbAdd_Click()
' This routine responses to the Add button click
' Find the next blank row at the end of column A
Set c = Range("a65536").End(xlUp).Offset(1, 0)
' Stop flashing screen as routine is being processed
Application.ScreenUpdating = False
' Write textbox entries in userform to new line at end of database
c.Value = Me.TextBox1.Value
c.Offset(0, 1).Value = Me.TextBox2.Value
c.Offset(0, 2).Value = Me.TextBox3.Value
c.Offset(0, 3).Value = Me.TextBox4.Value
c.Offset(0, 4).Value = Me.TextBox5.Value
c.Offset(0, 5).Value = Me.TextBox6.Value
c.Offset(0, 6).Value = Me.TextBox7.Value
c.Offset(0, 7).Value = Me.TextBox8.Value
c.Offset(0, 8).Value = Me.TextBox9.Value
c.Offset(0, 9).Value = Me.TextBox10.Value
c.Offset(0, 10).Value = Me.ComboBox1.Value
c.Offset(0, 11).Value = Me.TextBox12.Value
c.Offset(0, 12).Value = Me.TextBox13.Value
c.Offset(0, 13).Value = Me.TextBox14.Value
c.Offset(0, 14).Value = Me.TextBox15.Value
c.Offset(0, 15).Value = Me.TextBox16.Value
c.Offset(0, 16).Value = Me.TextBox17.Value
c.Offset(0, 17).Value = Me.TextBox18.Value
c.Offset(0, 18).Value = Me.TextBox19.Value
c.Offset(0, 19).Value = Me.TextBox20.Value
c.Offset(0, 20).Value = Me.TextBox21.Value
c.Offset(0, 21).Value = Me.TextBox22.Value
' Clear the userform
With Me
.TextBox1.Value = vbNullString
.TextBox2.Value = vbNullString
.TextBox3.Value = vbNullString
.TextBox4.Value = vbNullString
.TextBox5.Value = vbNullString
.TextBox6.Value = vbNullString
.TextBox7.Value = vbNullString
.TextBox8.Value = vbNullString
.TextBox9.Value = vbNullString
.TextBox10.Value = vbNullString
.ComboBox1.Value = vbNullString
.TextBox12.Value = vbNullString
.TextBox13.Value = vbNullString
.TextBox14.Value = vbNullString
.TextBox15.Value = vbNullString
.TextBox16.Value = vbNullString
.TextBox17.Value = vbNullString
.TextBox18.Value = vbNullString
.TextBox19.Value = vbNullString
.TextBox20.Value = vbNullString
.TextBox21.Value = vbNullString
.TextBox22.Value = vbNullString
End With
' Restores automatic updating of screen even as routine is being processed
Application.ScreenUpdating = True
End Sub
Private Sub cmbCancel_Click()
' Clears and closes userform and returns to database
With Me
.TextBox1.Value = vbNullString
.TextBox2.Value = vbNullString
.TextBox3.Value = vbNullString
.TextBox4.Value = vbNullString
.TextBox5.Value = vbNullString
.TextBox6.Value = vbNullString
.TextBox7.Value = vbNullString
.TextBox8.Value = vbNullString
.TextBox9.Value = vbNullString
.TextBox10.Value = vbNullString
.ComboBox1.Value = vbNullString
.TextBox12.Value = vbNullString
.TextBox13.Value = vbNullString
.TextBox14.Value = vbNullString
.TextBox15.Value = vbNullString
.TextBox16.Value = vbNullString
.TextBox17.Value = vbNullString
.TextBox18.Value = vbNullString
.TextBox19.Value = vbNullString
.TextBox20.Value = vbNullString
.TextBox21.Value = vbNullString
.TextBox22.Value = vbNullString
.ListBox1.Clear
End With
frmMain.Hide
Selection.AutoFilter Field:=1
Range("A4").Select
Application.ScreenUpdating = True
On Error GoTo 0
End Sub
Private Sub cmbClear_Click()
' Clears userform
With Me
.TextBox1.Value = vbNullString
.TextBox2.Value = vbNullString
.TextBox3.Value = vbNullString
.TextBox4.Value = vbNullString
.TextBox5.Value = vbNullString
.TextBox6.Value = vbNullString
.TextBox7.Value = vbNullString
.TextBox8.Value = vbNullString
.TextBox9.Value = vbNullString
.TextBox10.Value = vbNullString
.ComboBox1.Value = vbNullString
.TextBox12.Value = vbNullString
.TextBox13.Value = vbNullString
.TextBox14.Value = vbNullString
.TextBox15.Value = vbNullString
.TextBox16.Value = vbNullString
.TextBox17.Value = vbNullString
.TextBox18.Value = vbNullString
.TextBox19.Value = vbNullString
.TextBox20.Value = vbNullString
.TextBox21.Value = vbNullString
.TextBox22.Value = vbNullString
.ListBox1.Clear
.cmbAmend.Enabled = False
.cmbDelete.Enabled = False
.cmbAdd.Enabled = True
End With
Selection.AutoFilter Field:=1
Range("A4").Select
End Sub
Private Sub cmbDelete_Click()
' This routine is a response to the Delete button being clicked.
Dim msgResponse As String
' Stop flashing screen as routine is being processed
Application.ScreenUpdating = False
' Verify that the user wants to delete record shown in userform
msgResponse = MsgBox("This will delete the selected record. Continue?", _
vbCritical + vbYesNo, "Delete Record")
' Response based on answer clicked in message box
Select Case msgResponse
' If "Yes" button is selected
Case vbYes
' The value c has been selected by the Find button
Set c = ActiveCell
' This deletes record selected by the Find button
c.EntireRow.Delete
' This sets the Amend, Delete, and Add buttons
With Me
.cmbAmend.Enabled = False 'prevent accidental use
.cmbDelete.Enabled = False 'prevent accidental use
.cmbAdd.Enabled = True 'restore use
'
' Clear userform
.TextBox1.Value = vbNullString
.TextBox2.Value = vbNullString
.TextBox3.Value = vbNullString
.TextBox4.Value = vbNullString
.TextBox5.Value = vbNullString
.TextBox6.Value = vbNullString
.TextBox7.Value = vbNullString
.TextBox8.Value = vbNullString
.TextBox9.Value = vbNullString
.TextBox10.Value = vbNullString
.ComboBox1.Value = vbNullString
.TextBox12.Value = vbNullString
.TextBox13.Value = vbNullString
.TextBox14.Value = vbNullString
.TextBox15.Value = vbNullString
.TextBox16.Value = vbNullString
.TextBox17.Value = vbNullString
.TextBox18.Value = vbNullString
.TextBox19.Value = vbNullString
.TextBox20.Value = vbNullString
.TextBox21.Value = vbNullString
.TextBox22.Value = vbNullString
End With
' If "No" button is clicked delete action is cancelled
Case vbNo
Exit Sub
End Select
' Restores automatic updating of screen even as routine is being processed
Application.ScreenUpdating = True
End Sub
Private Sub cmbFind_Click()
' This routine searches for records based on user input
Dim strFind, LastName As String 'what to find
Dim rSearch As Range 'range to search
Dim f As Integer
Set rSearch = Sheet3.Range("a3", Range("a65536").End(xlUp))
strFind = Me.TextBox1.Value '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
.TextBox2.Value = c.Offset(0, 1).Value
.TextBox3.Value = c.Offset(0, 2).Value
.TextBox4.Value = c.Offset(0, 3).Value
.TextBox5.Value = c.Offset(0, 4).Value
.TextBox6.Value = c.Offset(0, 5).Value
.TextBox7.Value = c.Offset(0, 6).Value
.TextBox8.Value = c.Offset(0, 7).Value
.TextBox9.Value = c.Offset(0, 8).Value
.TextBox10.Value = c.Offset(0, 9).Value
.ComboBox1.Value = c.Offset(0, 10).Value
.TextBox12.Value = c.Offset(0, 11).Value
.TextBox13.Value = c.Offset(0, 12).Value
.TextBox14.Value = c.Offset(0, 13).Value
.TextBox15.Value = c.Offset(0, 14).Value
.TextBox16.Value = c.Offset(0, 15).Value
.TextBox17.Value = c.Offset(0, 16).Value
.TextBox18.Value = c.Offset(0, 17).Value
.TextBox19.Value = c.Offset(0, 18).Value
.TextBox20.Value = c.Offset(0, 19).Value
.TextBox21.Value = c.Offset(0, 20).Value
.TextBox22.Value = c.Offset(0, 21).Value
' This resets the Amend, Delete, and Add buttons
.cmbAmend.Enabled = True 'allow amendment or
.cmbDelete.Enabled = True 'allow record deletion
.cmbAdd.Enabled = False 'don't allow duplicate record
f = 0
End With
LastName = c.Address
Do
f = f + 1 'count number of matching records
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> LastName
If f > 1 Then
MsgBox "There are " & f & " instances of " & strFind
Me.Height = frmMax
End If
Else: MsgBox strFind & " not listed" 'search found no matches
End If
End With
End Sub
Private Sub cmbAmend_Click()
Application.ScreenUpdating = False
If rng Is Nothing Then GoTo skip
For Each c In rng
If r = 0 Then c.Select
r = r - 1
Next c
skip:
Set c = ActiveCell
c.Value = Me.TextBox1.Value ' write amendments to database
c.Offset(0, 1).Value = Me.TextBox2.Value
c.Offset(0, 2).Value = Me.TextBox3.Value
c.Offset(0, 3).Value = Me.TextBox4.Value
c.Offset(0, 4).Value = Me.TextBox5.Value
c.Offset(0, 5).Value = Me.TextBox6.Value
c.Offset(0, 6).Value = Me.TextBox7.Value
c.Offset(0, 7).Value = Me.TextBox8.Value
c.Offset(0, 8).Value = Me.TextBox9.Value
c.Offset(0, 9).Value = Me.TextBox10.Value
c.Offset(0, 10).Value = Me.ComboBox1.Value
c.Offset(0, 11).Value = Me.TextBox12.Value
c.Offset(0, 12).Value = Me.TextBox13.Value
c.Offset(0, 13).Value = Me.TextBox14.Value
c.Offset(0, 14).Value = Me.TextBox15.Value
c.Offset(0, 15).Value = Me.TextBox16.Value
c.Offset(0, 16).Value = Me.TextBox17.Value
c.Offset(0, 17).Value = Me.TextBox18.Value
c.Offset(0, 18).Value = Me.TextBox19.Value
c.Offset(0, 19).Value = Me.TextBox20.Value
c.Offset(0, 20).Value = Me.TextBox21.Value
c.Offset(0, 21).Value = Me.TextBox22.Value
'Clear userform and restore buttons
With Me
.TextBox1.Value = vbNullString
.TextBox2.Value = vbNullString
.TextBox3.Value = vbNullString
.TextBox4.Value = vbNullString
.TextBox5.Value = vbNullString
.TextBox6.Value = vbNullString
.TextBox7.Value = vbNullString
.TextBox8.Value = vbNullString
.TextBox9.Value = vbNullString
.TextBox10.Value = vbNullString
.ComboBox1.Value = vbNullString
.TextBox12.Value = vbNullString
.TextBox13.Value = vbNullString
.TextBox14.Value = vbNullString
.TextBox15.Value = vbNullString
.TextBox16.Value = vbNullString
.TextBox17.Value = vbNullString
.TextBox18.Value = vbNullString
.TextBox19.Value = vbNullString
.TextBox20.Value = vbNullString
.TextBox21.Value = vbNullString
.TextBox22.Value = vbNullString
.cmbAmend.Enabled = False
.cmbDelete.Enabled = False
.cmbAdd.Enabled = True
.Height = frmHt
End With
If Sheet3.AutoFilterMode Then Sheet3.ShowAllData
Application.ScreenUpdating = True
On Error GoTo 0
End Sub
Sub cmbFindAll_Click()
Dim strFind As String 'what to find
Dim rFilter As Range 'range to search
Set rFilter = Sheet3.Range("a3", Range("v65536").End(xlUp))
Set rng = Sheet3.Range("a4", Range("a65536").End(xlUp))
strFind = Me.TextBox1.Value
With Sheet3
If Not .AutoFilterMode Then .Range("A3").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).Value
.List(.ListCount - 1, 2) = c.Offset(0, 2).Value
.List(.ListCount - 1, 3) = c.Offset(0, 3).Value
.List(.ListCount - 1, 4) = c.Offset(0, 4).Value
.List(.ListCount - 1, 5) = c.Offset(0, 5).Value
.List(.ListCount - 1, 6) = c.Offset(0, 6).Value
.List(.ListCount - 1, 7) = c.Offset(0, 7).Value
.List(.ListCount - 1, 8) = c.Offset(0, 8).Value
.List(.ListCount - 1, 9) = c.Offset(0, 9).Value
'.List(.ListCount - 1, 10) = c.Offset(0, 10).Value
'.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 cmbLast_Click()
Dim LastCl As Range
Set LastCl = Range("a65536").End(xlUp) 'last used cell in column A
With Me
.cmbAmend.Enabled = False
.cmbDelete.Enabled = False
.cmbAdd.Enabled = True
.TextBox1.Value = LastCl.Value
.TextBox2.Value = LastCl.Offset(0, 1).Value
.TextBox3.Value = LastCl.Offset(0, 2).Value
.TextBox4.Value = LastCl.Offset(0, 3).Value
.TextBox5.Value = LastCl.Offset(0, 4).Value
.TextBox6.Value = LastCl.Offset(0, 5).Value
.TextBox7.Value = LastCl.Offset(0, 6).Value
.TextBox8.Value = LastCl.Offset(0, 7).Value
.TextBox9.Value = LastCl.Offset(0, 8).Value
.TextBox10.Value = LastCl.Offset(0, 9).Value
.ComboBox1.Value = LastCl.Offset(0, 10).Value
.TextBox12.Value = LastCl.Offset(0, 11).Value
.TextBox13.Value = LastCl.Offset(0, 12).Value
.TextBox14.Value = LastCl.Offset(0, 13).Value
.TextBox15.Value = LastCl.Offset(0, 14).Value
.TextBox16.Value = LastCl.Offset(0, 15).Value
.TextBox17.Value = LastCl.Offset(0, 16).Value
.TextBox18.Value = LastCl.Offset(0, 17).Value
.TextBox19.Value = LastCl.Offset(0, 18).Value
.TextBox20.Value = LastCl.Offset(0, 19).Value
.TextBox21.Value = LastCl.Offset(0, 20).Value
.TextBox22.Value = LastCl.Offset(0, 21).Value
End With
End Sub
Private Sub cmbSelect_Click()
If Me.ListBox1.ListIndex = -1 Then 'not selected
MsgBox " No selection made"
ElseIf Me.ListBox1.ListIndex >= 0 Then 'User has selected
r = Me.ListBox1.ListIndex
MsgBox (r)
With Me
.TextBox1.Value = ListBox1.List(r, 0)
.TextBox2.Value = ListBox1.List(r, 1)
.TextBox3.Value = ListBox1.List(r, 2)
.TextBox4.Value = ListBox1.List(r, 3)
.TextBox5.Value = ListBox1.List(r, 4)
.TextBox6.Value = ListBox1.List(r, 5)
.TextBox7.Value = ListBox1.List(r, 6)
.TextBox8.Value = ListBox1.List(r, 7)
.TextBox9.Value = ListBox1.List(r, 8)
.TextBox10.Value = ListBox1.List(r, 9)
'.ComboBox1.Value = ListBox1.List(r, 10)
'.TextBox12.Value = ListBox1.List(r, 11)
'.TextBox13.Value = ListBox1.List(r, 12)
'.TextBox14.Value = ListBox1.List(r, 13)
'.TextBox15.Value = ListBox1.List(r, 14)
'.TextBox16.Value = ListBox1.List(r, 15)
'.TextBox17.Value = ListBox1.List(r, 16)
'.TextBox18.Value = ListBox1.List(r, 17)
'.TextBox19.Value = ListBox1.List(r, 18)
'.TextBox20.Value = ListBox1.List(r, 19)
'.TextBox21.Value = ListBox1.List(r, 20)
'.TextBox22.Value = ListBox1.List(r, 21)
.cmbAmend.Enabled = True 'allow amendment or
.cmbDelete.Enabled = True 'allow record deletion
.cmbAdd.Enabled = False 'don't want duplicate
End With
End If
End Sub
Private Sub UserForm_Deactivate()
Sheet3.ShowAllData
End Sub
Private Sub UserForm_Initialize()
Set MyData = Sheet3.Range("a3").CurrentRegion
With Me
.Caption = "Judicial Employee Management Information System" 'userform caption
.Height = frmHt
End With
End Sub