Solved: Userform - Code as written will not populate all 22 data elements

[Bob Blooms]

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. I am new at VBA

The code I'm using is as follows:

[VBA]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[/VBA]

[nst1107]

I don't see an obvious reason for the code to crash there. Make sure the ColumnCount property of your listbox is appropriate. If that's not the problem, what is the error message?

[Bob Phillips]

A listbox can only hold 10 columns of data if unbound, if you want more you have to bind it.

[Bob Blooms]

Thanks for the quick responses. Wow this tough stuff. I thought this would be a great "hobby" in my retirement. You know, keep the mind busy.

In the properties section I have set both the 'boundcolumn' and 'columncount' to 22 (the number of data fields to be shown in the listbox. However, the program continues to stop at the 11th data field in Sub cmbFindAll_Click(). Do I need to add code to bind the listbox?

[Bob Phillips]

You need to point the RowSource property at a range of data on a worksheet.

[RolfJ]

Hi Bob:

Since you admitted that you are rather new to VBA, I thought it might help to offer you a couple of specific suggestions on how to improve on your code and its functionality. I will address two particular issues:

1. How to simplify your code by using a TextBox array
2. How to deal with the multicolumn limitation of the ListBox control

Issue 1:
By introducting a TextBox array you can greatly simplify your code and make it more compact and hence for legible. This is how that's done:

[vba]
Dim textBoxArray(21) As MSForms.TextBox

Private Sub UserForm_Initialize()
Set textBoxArray(0) = TextBox1
Set textBoxArray(1) = TextBox2
'and so on
Set textBoxArray(21) = TextBox22
End Sub

[/vba]

Issue 2:
One way to deal with the multicolumn limitation of the ListBox control is to add another (invisible) ListBox to your form (I called it in my code 'ListBox_RowIndices') in which you store the row indices for each of the occurrences found in the FindAll routine. Rather than pulling data from the ListBox you can then pull data directly from your worksheet when you select a specific item.
Of course this leaves you with a decision as to which of the data you want to include in the ListBox. For the sake of simplicity I opted to list the data in columns A through J.

Please find below the code revised with these two suggestions. It might not have every functionality you are trying to create, but I trust you will find this version considerably more manageable.

Please note that I eliminated the 'Select' button: once a search found multiple occurrences automatically lists them in your ListBox and selects the first item. If you click on another item in the ListBox is automatically displays the data for that item. There doesn't seem to be a need for the 'Select' button.

Please also note that I was unable to figure out how you are trying to use ComboBox1.

[vba]
Dim textBoxArray(21) As MSForms.TextBox
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
Const NTEXTBOXES = 22
Const SHEETNAME As String = "Sheet3"

Private Sub UserForm_Initialize()
Set textBoxArray(0) = TextBox1
Set textBoxArray(1) = TextBox2
Set textBoxArray(2) = TextBox3
' and so on
Set textBoxArray(21) = TextBox22
End Sub

Private Sub cmbAmend_Click()

Application.ScreenUpdating = False

If Not rng Is Nothing Then
For Each c In rng
If r = 0 Then c.Select
r = r - 1
Next c
End If

Set c = ActiveCell
Dim i As Integer
For i = 0 To NTEXTBOXES - 1
c.Offset(0, i).Value = textBoxArray(i).Value
Next i

ClearForm

If Worksheets(SHEETNAME).AutoFilterMode Then Worksheets(SHEETNAME).ShowAllData
Application.ScreenUpdating = True
End Sub

Private Sub cmbFindAll_Click()
Dim strFind As String 'what to find
Dim rFilter As Range 'range to search
Set rFilter = Worksheets(SHEETNAME).Range("A2", Range("A" & Rows.Count).End(xlUp))
strFind = Me.TextBox1.Value
With Worksheets(SHEETNAME)
If Not .AutoFilterMode Then .Range("A3").AutoFilter
rFilter.AutoFilter Field:=1, Criteria1:=strFind
On Error Resume Next
Set rng = Nothing
Set rng = rFilter.Cells.SpecialCells(xlCellTypeVisible)
If Not rng Is Nothing Then
Me.ListBox1.Clear
For Each c In rng.Rows
ListBox_RowIndices.AddItem c.Row
With Me.ListBox1
.AddItem c.Cells(1, 1).Value
Dim i As Integer
For i = 2 To 10
.List(.ListCount - 1, i - 1) = c.Cells(1, i).Value
Next i
End With
Next c
If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0
Else
MsgBox strFind & " not listed" 'search found no matches
rFilter.AutoFilter
End If
End With
End Sub

Private Sub ListBox1_Click()
If Me.ListBox1.ListIndex = -1 Then 'not selected
MsgBox " No selection made"
ElseIf Me.ListBox1.ListIndex >= 0 Then 'User has selected
r = ListBox_RowIndices.List(ListBox1.ListIndex)
Dim i As Integer
For i = 0 To NTEXTBOXES - 1
textBoxArray(i).Value = Worksheets(SHEETNAME).Cells(r, i + 1)
Next i
cmbAmend.Enabled = True 'allow amendment or
cmbDelete.Enabled = True 'allow record deletion
cmbAdd.Enabled = False 'don't want duplicate
End If
End Sub

Sub cmbAdd_Click()
Application.ScreenUpdating = False
Set c = Worksheets(SHEETNAME).Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
Dim i As Integer
For i = 0 To 21
c.Offset(0, i) = textBoxArray(i).Value
Next i
c.Offset(0, 10) = ComboBox1.Value
'Now clear the form:
ClearForm
Application.ScreenUpdating = True
End Sub

Sub cmbCancel_Click()
Application.ScreenUpdating = False
ClearForm
Me.Hide
'Selection.AutoFilter Field:=1
Worksheets(SHEETNAME).Range("A4").Select
Application.ScreenUpdating = True
End Sub

Sub cmbClear_Click()
ClearForm
End Sub

Private Sub cmbFind_Click()

ListBox1.Clear
Range("A3").AutoFilter

' 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 = Worksheets(SHEETNAME).Range("A3", Range("A" & Rows.Count).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
Dim i As Integer
For i = 0 To NTEXTBOXES - 1
textBoxArray(i).Value = c.Offset(0, i).Value
Next i
' 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
cmbFindAll_Click
End If
Else
MsgBox strFind & " not listed" 'search found no matches
End If
End With
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
Case vbYes
' This deletes record selected by the Find button
ActiveCell.EntireRow.Delete
ClearForm
Case vbNo
Exit Sub
End Select

' Restores automatic updating of screen even as routine is being processed
Application.ScreenUpdating = True
End Sub

Sub ClearForm()
Dim i As Integer
For i = 0 To 21
textBoxArray(i).Text = vbNullString
Next i
ComboBox1.Clear
ListBox1.Clear
cmbAmend.Enabled = False 'prevent accidental use
cmbDelete.Enabled = False 'prevent accidental use
cmbAdd.Enabled = True 'restore use
Me.Height = frmHt
End Sub

Private Sub UserForm_Deactivate()
Range("A3").AutoFilter
End Sub

Private Sub UserForm_Terminate()
Range("A3").AutoFilter
End Sub
[/vba]

Hope this helped,
Rolf Jaeger
SoarentComputing
http://soarentcomputing.com/SoarentC...lSolutions.htm

[Bob Blooms]

Wow! A real way cool Wow!

My long term objective is to help a good friend of mine become a Super Hero, in the eyes of her boss. She took on a new responsibility of generating pesonnel cost forecast. I got that down pat, meaning that all the necessary formulae are ok. The problem is keeping the database error free (SixSigma).

For this reason I am attempting to develop the userform. The combobox is linked to choices in medical insurance, which drives personnel costs. The choice of medical insurance is limited to the plans enforce. For starters I think I should have used a listbox.

You have overwhelmed me with the code. I need to study it and get the feel of what it is doing.

Will be back to you soon.

Again Thanks.

[RolfJ]

Hi Bob:

Sorry this seemed a bit overwhelming, but I am quite sure that you wil become better at writing VBA code if you take the time to study what I sent you, as you said you would. But please don't hesitate to ask questions, if you wish in direct e-mail to me, if you don't understand any part of my code.

Best wishes,
Rolf Jaeger
SoarentComputing
http://soarentcomputing.com/SoarentC...lSolutions.htm