Writing the Code for the Userform Module

The program's data is stored in a random access file. The advantage to this type of file is that it can be quickly updated as long as your program correctly tracks the record number. In order to do this, a custom data type is required to ensure each record uses the same amount of memory. The custom data type named PuzzleList is built from three elements: a long integer and two strings. The long integer is an identification number (IDNum), and as you will see, I use it to make finding specific records easier. The two strings will hold the topics and words. The integer variable recNum is still required to serve as a place locator for I/O operations on a random access file. The value of the recNum variable will match that of the identification number which makes it easier to locate and update records in the data file. A variable array of type PuzzleList is declared at module level to be used in reading the data from the file and writing it out to the hidden worksheet.

Option Explicit Private recNum As Integer Private Type PuzzleList IDNum As Long topic As String * 30 word As String * 15 End Type

Private curList() As PuzzleList

When the form is shown, its Activate() event procedure is triggered and its code calls the procedures that load the data from the file and writes it to the hidden worksheet. The data file's topics are retrieved from the worksheet by passing the dynamic array variable topics to the GetUniqueTopics() sub procedure. The name of the procedure, GetUniqueTopics(), implies its function. Remember that the data file, and thus the hidden worksheet, contains a topic for every word; therefore numerous repeat values for the topic exist. The array is passed by reference, so when it is re-dimensioned and filled with values in the GetUniqueTopics() sub procedure, it can be added to the Combo Box control via its List property (the List property of the Combo Box control is a variant array). The last line of code in the Activate() event procedure sets the topic that will be displayed in the Combo Box control. Be aware that setting the Value property of a Combo Box control triggers its Change() event.

Private Sub UserForm_Activate() Dim topics() As String

'Initialize worksheet and controls.

GetAllRecords WriteToWorksheet GetUniqueTopics topics cmbTopics.List = topics cmbTopics.Value = cmbTopics.List(O) End Sub

The purpose of the GetAllRecords() sub procedure is to load the data from the file and store it in the module level variable array curList. Because the procedure involves file I/O, some validation and error handling code is included.

To avoid file I/O errors that may crash the program, first the path to the Workdfind.txt file must be validated and appropriate action taken if the file is not found. The Dir() function serves to validate the file path. The Dir() function is a member of the FileSystem object, but can be used without its object qualifier. In the GetAllRecords() sub procedure, the Dir() function returns the string "WordFind.txt" if this file is found at the specified path. If the file does not exist at the specified path then the Dir() function returns a zero-length string ("") and the GetFile() function is called to display a file dialog and give the user a chance to find and select the file to open. If the user finds the file and selects OK, then its path is returned to the variable filePath. If the file's path is not found and the user selects Cancel, then code execution continues.

The second step in avoiding a program crash from a file I/O error is adding an error handler. Although it is difficult to foresee errors other than an invalid path and/or file name, certainly more possibilities for file I/O errors exist (for example, a corrupt file); therefore, the error handler is added to display a message box indicating the nature of the error and end the program. The error handler is also called if the file path is invalid and the user chooses to cancel the file dialog used to find the file (this returns an empty string for the file path). I handle the error this way because of the difficulty in predicting what error might occur. All I know is that the Open statement has failed, so the program must end. Most importantly, the error handler prevents the program from crashing and starting the debugger.

Normally, I would place the call to the GetFile() sub procedure in the error handler, but the Open statement does not fail if a valid path is used and the file is not found at this location. Instead a new file is created and that's not the required action.

Private Sub GetAllRecords() Dim filePath As String Dim curRec As PuzzleList

'Load all records from random access text file into 'variable array of custom data type.

On Error GoTo FilelOError filePath = ActiveWorkbook.Path & "\Wordfind.txt"

'Test for valid path.

If Dir(filePath) <> "Wordfind.txt" Then filePath = GetFile End If

'Open the file and fill records into custom 'variable array.

recNum = 1

Open filePath For Random Access Read As #1 Len = Len(curRec)

Do While Not EOF(1)

Get #1, recNum, curRec ReDim Preserve curList(recNum - 1) curList(recNum - 1).IDNum = curRec.IDNum curList(recNum - 1).word = curRec.word curList(recNum - 1).topic = curRec.topic recNum = recNum + 1

Loop

Close #1

Exit Sub

'Use error handler for unforeseen errors.

FilelOError:

MsgBox "The program has encountered an error trying to " & _

"access the file Wordfind.txt. " & vbCrLf & Err.Description, vbCritical, "Error " & Err.Number

End Sub

The GetFile() sub procedure is only called from the GetAllRecords() sub procedure when the data file is not found at the specified path. The procedure shows a FileDialog object to allow the user to search the computer's file structure in order to locate the file. If the user locates the file and clicks the OK button, then the file's path is returned to the calling function.

Private Function GetFile() As String Dim fileDiag As FileDialog

'Configure and show the open dialog. 'Return path to calling function.

Set fileDiag = Application.FileDialog(msoFileDialogFilePicker) With fileDiag 'Configure dialog box .Filters.Clear

.Filters.Add Description:="All files", Extensions:="*.*" .Filters.Add Description:="Text", Extensions:="*.txt", Position:=1 .AllowMultiSelect = False .Filterlndex = 1

.Title = "Select Wordfind.txt File"

.InitialFileName = ""

If .Show = -1 Then 'User clicked Open

GetFile = .Selectedltems(l) 'Return path to selected file End If End With End Function

The data is written to a hidden worksheet named Lists that is in the same workbook as the Wordfind puzzle worksheet. After the sheet is cleared, the topics, words, and identification numbers are copied to the first three columns of the Lists worksheet from the module level variable array curList (this variable was initialized in the GetAllRecords() sub procedure) using a For/Next loop. I qualify the Lists worksheet with an object variable (ws) because it is never the active worksheet.

The last statement in the procedure sorts the data alphabetically, first by topic and then by word. This is the major reason I write the data to the worksheet—to take advantage of its fast sorting capabilities so the data is listed alphabetically in the ActiveX controls. Furthermore, when the topics are sorted alphabetically, it's easier to pick out the unique values from the list. Note that I passed the Sort() method of the Range object several arguments. They are all optional, but at the very least, Keyl and Key2 must be included in order to specify the primary and secondary keys on which to sort, which in this case, are the topic and word, respectively. I also included the MatchCase argument to specify a case-insensitive sort. You can also pass the Sort() method arguments that specify the sort order for each key (Orderl, Order2), whether or not to ignore a header row (Header), whether to sort by rows or columns (Orientation), and whether or not to treat numbers as text for each key (DataOptionl, DataOption2).

Excel worksheets are hidden and unhidden by selecting Format, Sheet, Hide/Unhide in the application window.

Private Sub WriteToWorksheet() Dim lastRow As Integer Dim ws As Worksheet Dim I As Integer

Set ws = Worksheets("Lists")

'Clear the worksheet lastRow = ws.UsedRange.Rows.Count ws.Range("A2:C" & lastRow).ClearContents

'Write records to worksheet

For I = 2 To recNum ws.Cells(I, "A").Value = Trim(curList(I - 2).topic)

ws.Cells(I, "B").Value = Trim(curList(I - 2).word)

ws.Cells(I, "C").Value = Trim(curList(I - 2).IDNum) Next I

'Sort records.

ws.Range("A2:C" & recNum).Sort Key1:=ws.Range("A2"), Key2:=ws.Range("B2"), _ MatchCase:=False

End Sub

When the user selects a new topic, the Change() event of the Combo box is triggered and the List Box is updated with the words associated with the selected topic. This event is also triggered from the Activated event of the UserForm object when the List property of the Combo Box is assigned the values in the variable array topics. The words are added to the List Box by the GetWords() sub procedure which reads the values from the hidden worksheet.

Private Sub cmbTopics_Change()

txtTopic.Text = cmbTopics.Text txtWord.Text = "" cmdUpdate.Enabled = False GetWords End Sub

Private Sub GetWords() Dim I As Integer Dim ws As Worksheet

'Add word list to list box associated with 'topic on combo box.

lstWords.Clear

Set ws = Worksheets("Lists")

For I = 2 To ws.UsedRange.Rows.Count

If ws.Cells(I, "A").Value = cmbTopics.Value Then lstWords.Addltem ws.Cells(I, "B").Value End If Next I End Sub

The Click() event of the List Box is triggered whenever the user selects a new value from its list. After the selected word is copied to the Text Box control, the ID number associated with the selected word is retrieved using the GetIDNum() function. The ID number is copied to a Label control on the form. I originally added the Label control to the form to test and help debug the program. It serves no purpose to allow the user to see this value; however, the

Label control serves as a convenient location for storing the number of the record currently displayed on the form. The record number is required for updating the file so it can simply be read from the Label control when the user selects the Update button. If you like, you can set the Visible property of the Label control to false to prevent the user from seeing the record number. Figure 7.18 shows an example of how the form appears when a word has been selected from the List Box control.

The update form from the Word Find program displaying a user-selection.

The update form from the Word Find program displaying a user-selection.

Private Sub lstWords_Click()

txtWord.Text = lstWords.Text lblIDNum.Caption = GetIDNum cmdUpdate.Enabled = True End Sub

Private Function GetIDNum() As Long Dim ws As Worksheet Dim c1 As Range, c2 As Range

'Loop through columns A and B in Lists worksheet to find 'the correct topic and word and then return ID number.

Set ws = Worksheets("Lists")

For Each c2 In ws.Range("A2:A" & ws.UsedRange.Rows.Count) If c2.Value = cmbTopics.Value Then

For Each c1 In ws.Range("B2:B" & ws.UsedRange.Rows.Count) If cl.Value = lstWords.Text Then

GetIDNum = ws.Range("C" & c1.Row).Value Exit Function End If

Next End If

Next End Function

To add a new record to the data file, the user must simply enter values for the topic and word before clicking the Add New button. Calls to the AddRecToWorksheet(), AddToControls(), and AddToFile() sub procedures update the hidden Lists worksheet and the ActiveX controls, and add a new record to the data file. Note that a new ID number must be assigned to the new record. The code in these procedures should be familiar to you.

Private Sub cmdAddNew_Click()

'If nothing in text boxes then exit the sub.

If txtWord.Text = "" Or txtTopic.Text = "" Then

MsgBox "You must enter a topic and word before updating the list.", vbOKOnly, "No Entry" txtWord.SetFocus Exit Sub End If

'Add the new record to the Lists worksheet, the file, 'the List box, and the combo box.

AddRecToWorksheet

AddToControls

AddToFile txtWord.Text = "" recNum = recNum + 1 End Sub

Private Sub AddRecToWorksheet() Dim ws As Worksheet

'Update the "Lists" worksheet with the new record.

Set ws = Worksheets("Lists")

ws.Cells(recNum + 1, "A").Value = txtTopic.Text ws.Cells(recNum + 1, "B").Value = txtWord.Text ws.Cells(recNum + 1, "C").Value = recNum ws.Range("A2:C" & recNum + 1).Sort Key1:=ws.Range("A2"), Key2:=ws.Range("B2"), _

Order1:=xlAscending, Header:=xlNo, MatchCase:=False, Orientation:=xlSortColumns, DataOption1:=xlSortNormal

End Sub

Private Sub AddToControls() Dim I As Integer

'Update the controls on the Userform. 'Update topic only if its new.

IbllDNum.Caption = recNum lstWords.AddItem txtWord.Text

For I = 0 To cmbTopics.ListCount - 1

If cmbTopics.List(I) = txtTopic.Text Then

Exit Sub 'The topic is not new, so exit sub. End If Next I

cmbTopics.AddItem txtTopic.Text End Sub

Private Sub AddToFile()

Dim filePath As String Dim curRec As PuzzleList

On Error GoTo FilelOError

'Test for valid path.

filePath = ActiveWorkbook.Path & "\Wordfind.txt" If Dir(filePath) <> "Wordfind.txt" Then filePath = GetFile End If curRec.topic = txtTopic.Text curRec.word = txtWord.Text curRec.IDNum = recNum

'Add the new record to the random access text file.

Open filePath For Random Access Write As #1 Len = Len(curRec) Put #1, recNum, curRec Close #1 Exit Sub

'Use error handler for unforseen errors.

FilelOError:

MsgBox Err.Description, vbCritical, "Error " & Err.Number End

End Sub

Updating the data file is a bit trickier. Care has to be taken to ensure the correct record in the file is overwritten. This is where the Label control becomes so convenient because its Caption property holds the number of the currently displayed record. A record is updated when the user clicks the Update button, presumably after editing an existing word from the list. The Click() event procedure of the Update button updates the Lists worksheet, the ActiveX controls, and the data file with calls to UpdateWorksheet(), UpdateControls(), and UpdateFile(), respectively. Note that the topic is validated before the record is updated because the program requirements specified that no updates to the topics are allowed.

Private Sub cmdUpdate_Click() Dim I As Integer

Dim validTopic As Boolean

For I = 0 To cmbTopics.ListCount - 1

If cmbTopics.List(I) = txtTopic.Text Then validTopic = True Exit For End If Next I

If Not validTopic Then

MsgBox "You must use a current topic before updating a record.", vbOKOnly, "No Valid Topic" Exit Sub End If

'Update record in worksheet, controls, and text file. 'Only allow updates to the word and not the topic.

UpdateWorksheet

UpdateControls

UpdateFile cmdUpdate.Enabled = False End Sub

Private Sub UpdateWorksheet() Dim ws As Worksheet Dim updateRow As Long

Set ws = Worksheets("Lists")

updateRow = ws.Range("C2:C" & ws.UsedRange.Rows.Count).Find(lblIDNum).Row ws.Range("B" & updateRow).Value = txtWord.Text End Sub

Private Sub UpdateControls()

'Update the list box containing the words.

IstWords.List(lstWords.Listlndex) = txtWord.Text End Sub

Private Sub UpdateFile() Dim filePath As String Dim curRec As PuzzleList

On Error GoTo FilelOError filePath = ActiveWorkbook.Path & "\Wordfind.txt"

'Test for valid path.

If Dir(filePath) <> "Wordfind.txt" Then filePath = GetFile End If

'Update current record.

curRec.IDNum = IbllDNum.Caption curRec.topic = txtTopic.Text curRec.word = txtWord.Text

Open filePath For Random Access Write As #1 Len = Len(curRec) Put #1, Val(lbllDNum.Caption), curRec Close #1

Exit Sub

'Use error handler for unforeseen errors.

FilelOError:

MsgBox Err.Description, vbCritical, "Error " & Err.Number End

End Sub

The last procedure listed in the code module for the UserForm object is the QueryClose() event procedure that is simply used to hide the form.

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

frmWordFind.Hide End Sub

Because the GetUniqueTopics() sub procedure is called from the code modules for the UserForm and the Worksheet objects, I entered it into a standard code module and gave it public scope. It is called from the Activate() event of the UserForm object in order to retrieve the unique values for the topics listed in the Lists worksheet. The variable array topics is passed by reference and filled with the unique topics from column A of the worksheet.

Public Sub GetUniqueTopics(topics() As String) Dim c As Range, cRange As Range Dim ws As Worksheet Dim lastRow As Integer Dim curValue As String Dim I As Integer

'Set object variables. The range should only be 'set to the used portion of column A.

Set ws = Worksheets("Lists")

lastRow = ws.UsedRange.Rows.Count

Set cRange = ws.Range("A2:A" & lastRow)

'Loop through column A in Lists worksheet and find 'all unique topics.

For Each c In cRange

If c.Value <> curValue Then ReDim Preserve topics(I) curValue = c.Value topics(I) = c.Value I = I + 1 End If

Next End Sub

Biorhythm Awareness

Biorhythm Awareness

Who else wants to take advantage of biorhythm awareness to avoid premature death, escape life threatening diseases, eliminate most of your life altering mistakes and banish catastrophic events from your life.

Get My Free Ebook


Post a comment