ListBox Headers and Sorting

[Bob Blooms]

I continue to struggle with my ListBox processing. I can get data into the list box. From there I can select a record and delete or update it. However, what I cannot provide the user is a list in alphabetical order or include headers.

The search of the database allows the user to put as little as one letter to find a last name. This means that the number of records returned and shown in the listbox varies. Since I do not want to show the complete database, I have left the RowSource blank and the ColumHeads to False. I am lost on what the next step should be to get the headers to show.

As for the sorting, presently I have a sub that sorts the database before getting to the ListBox routine. It works, but I'm taking the easy way out, I think! Any ideas?

[lucas]

This seems to be the continuation of another thread. If so, at least a link would help. You should post your workbook. We can't see over your shoulder to see what you have done so far.

[Bob Blooms]

The following is my present code. I think what is of importance here is command buttons 1 and 2.


[VBA]
Option Explicit 'Variables must be declared before they can be used
Option Compare Text 'Removes case sensitivity "A" is equal to "a"
Option Base 1 'Array starts with "1" rather than default "0"
Dim arrLastName(800) As Variant 'Array that holds Last Names from workbook
Dim arrFoundLastName(800) As Variant 'Array holds list of matched records
Dim arrSmall(100, 22) As Variant 'Array holds records that meet search criteria
Dim arrBig(800, 22) As Variant 'Array holds data from Sheet1
Dim strLastName As String 'User input variable used to find matches
Dim strEnterNote As String 'Comment to appear in TextBox100 (Search for Last Name)
Dim intLastNameCounter As Integer 'Counter used to load arrLastName with line number of match
Dim intFoundName As Integer 'Counter for number of matched last names
Dim intLastRow As Integer 'Holds the calculated last row of data value
Dim intPartOfLastName As Integer 'Calculates how many characters input by user
Dim intBigCounter As Integer
Dim intLoopBig As Integer
Dim intSmallCounter As Integer
Dim intLoopSmall
Dim r As Integer
Dim msgResponse As Variant
Public myData As Range, c As Range
Private Sub CommandButton1_Click() 'Find

Call ClearTextBoxes
ListBox1.Clear
strLastName = TextBox100
If strLastName = strEnterNote Then Call ErrorMsg
intPartOfLastName = Len(strLastName) 'Just in case the user enters a partial name,
'this helps to setup for modified wildcard search
'by establishing what portion of the last name is verified
strLastName = Left(strLastName, intPartOfLastName) 'Allows for searches for using Left part of a last name
' This loop compares strLastName to Last Name in database
Sheet1.AutoFilterMode = False 'Makes all records visible
intFoundName = 1
intLastRow = Worksheets("Sheet1").Range("a65536").End(xlUp).Row
For intLoopBig = 2 To intLastRow
If Left(Worksheets("Sheet1").Cells(intLoopBig, 1), intPartOfLastName) = strLastName Then
arrLastName(intFoundName) = intLoopBig
intFoundName = intFoundName + 1
End If
Next intLoopBig
If intFoundName = 1 Then MsgBox "No matches for " & strLastName & " were found", vbCritical, "JEMIS Error Message"
'Loads data into arrSmall
For intSmallCounter = 1 To intFoundName - 1
For intLoopSmall = 1 To 21
arrSmall(intSmallCounter, intLoopSmall) = _
Worksheets("Sheet1").Cells(arrLastName(intSmallCounter), intLoopSmall)
Next intLoopSmall
Next intSmallCounter
UserForm1.ListBox1.List = arrSmall

CommandButton1.Enabled = False 'Find
CommandButton2.Enabled = True 'Select
CommandButton3.Enabled = False 'Amend
CommandButton5.Enabled = False 'Add
CommandButton6.Enabled = False 'Delete
CommandButton4.Enabled = True 'Exit
CommandButton7.Enabled = True 'Clear
End Sub

Private Sub CommandButton2_Click() 'Select

Call ClearTextBoxes


CommandButton1.Enabled = False 'Find
CommandButton2.Enabled = True 'Select
CommandButton3.Enabled = True 'Amend
CommandButton5.Enabled = False 'Add
CommandButton6.Enabled = True 'Delete
CommandButton4.Enabled = True 'Exit
CommandButton7.Enabled = True 'Clear


If Me.ListBox1.ListIndex = -1 Then 'not selected
MsgBox " No selection made", vbExclamation, "JEMIS Select Error"
ElseIf Me.ListBox1.ListIndex >= 0 Then 'User has selected


r = Me.ListBox1.ListIndex

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)
.TextBox11.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)
End With
End If
End Sub
Private Sub CommandButton3_Click() 'Change
If TextBox1 <> "" Then
Dim myAnswer As String
Dim myNote As String
myNote = "Do you want to apend selected record?"
myAnswer = MsgBox(myNote, vbQuestion + vbYesNo + vbDefaultButton2, "JEMIS _ Append Record")
If myAnswer = vbYes Then
Call AppendRecord
Call UserForm_Initialize

End If
End If

End Sub
Private Sub CommandButton4_Click() 'Exit
Dim myMainform As Object
Unload Me
Set myMainform = frmMain
Sheet2.Activate
End Sub
Private Sub CommandButton5_Click() 'Add Record
If TextBox1 <> "" Then
Set c = Range("a65536").End(xlUp).Offset(1, 0)
Application.ScreenUpdating = False
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.TextBox11.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


Dim intIDno As Integer
Dim ID As Range

intIDno = Application.WorksheetFunction.Max(Range("ID"))
c.Offset(0, 22).Value = intIDno + 1

Call ClearTextBoxes
Call UserForm_Initialize
Application.ScreenUpdating = True

Else
MsgBox "Last Name not entered"
End If
End Sub
Private Sub CommandButton6_Click() 'Delete

Dim msgResponse As Variant
Application.ScreenUpdating = False
msgResponse = MsgBox("This will delete the selected record. Continue?", _
vbCritical + vbYesNo + vbDefaultButton2, "JEMIS Delete Record")
Select Case msgResponse
Case vbYes
Set c = Worksheets(1).Range("A" & arrLastName(r + 1))
c.EntireRow.Delete
Call ClearTextBoxes
ListBox1.Clear
CommandButton1.Enabled = False
CommandButton2.Enabled = False
CommandButton3.Enabled = False
CommandButton5.Enabled = False
CommandButton6.Enabled = False
Case vbNo
Exit Sub
End Select
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton7_Click() 'Clear

Call UserForm_Initialize

End Sub
Private Sub ListBox1_Click()
If ListBox1.Value <> "" Then
CommandButton1.Enabled = False 'Find
CommandButton2.Enabled = True 'Select
CommandButton3.Enabled = False 'Amend
CommandButton5.Enabled = False 'Add
CommandButton6.Enabled = False 'Delete
CommandButton4.Enabled = True 'Exit
CommandButton7.Enabled = True 'Clear
Else
CommandButton1.Enabled = False
End If
End Sub
Private Sub TextBox100_Change()
If TextBox100.Value <> strEnterNote Then
CommandButton1.Enabled = True
CommandButton2.Enabled = False
CommandButton3.Enabled = False
CommandButton5.Enabled = False
CommandButton6.Enabled = False
CommandButton4.Enabled = True
CommandButton7.Enabled = True

Else
CommandButton1.Enabled = False
End If
End Sub
Private Sub UserForm_Deactivate()
frmMain.Show

End Sub
Private Sub UserForm_Initialize()
Worksheets("Sheet1").Activate
CommandButton1.Enabled = False 'Find
CommandButton2.Enabled = False 'Select
CommandButton3.Enabled = False 'Amend
CommandButton5.Enabled = True 'Add
CommandButton6.Enabled = False 'Delete
CommandButton4.Enabled = True 'Exit
CommandButton7.Enabled = True 'Clear

Erase arrLastName 'Array that holds Last Names from workbook
Erase arrFoundLastName 'Array holds list of matched records
Erase arrSmall 'Array holds records that meet search criteria
Erase arrBig
Call StringNotes
TextBox100.Value = strEnterNote
Set myData = Sheet1.Range("a1").CurrentRegion
Me.Caption = "Judicial Employee Management Information System" 'userform caption
Call ClearTextBoxes
ListBox1.Clear
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) 'Disable X button

If CloseMode = 0 Then
Cancel = True
MsgBox "The X is disabled, please use Close Form button on the form.", _
vbCritical, "JEMIS Close Error"
End If

End Sub
Private Sub AppendRecord()
Application.ScreenUpdating = False

Set c = Worksheets(1).Range("A" & arrLastName(r + 1))
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.TextBox11.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

Call ClearTextBoxes
ListBox1.Clear
TextBox100.Value = strEnterNote
If Sheet1.AutoFilterMode Then Sheet1.ShowAllData
Application.ScreenUpdating = True
On Error GoTo 0
End Sub
Private Sub ErrorMsg()
MsgBox "No Information was supplied, try again", vbCritical, "JEMIS Error Msg"
End Sub
Private Sub ClearTextBoxes()
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
.TextBox11.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

End Sub
Public Sub StringNotes()
strEnterNote = "Enter last name to be found"
End Sub
[/VBA]

Edit Lucas: VBA tags added to your code. Select the code when posting or editing and hit the vba button to format it for the forum.

[lucas]

Hi Bob, you can select your code when posting and hit the vba button to format it for the forum.

I got your pm.

I would suggest that you actually attach your workbook after taking out any personal or private info. I don't really relish rebuilding something that you already have in order to help you and I might not do it the same way.

To attach your workbook go the post reply at the bottom left of the last post and when the page loads, add your message and scroll down. Look for the button that says "manage attachments"