Simply the Best Phone Book - Contact Manager This is a VBA Excel series that will develop this fantastic phone contact interface. Everything is managed from the userform. Template with the userform can be downloaded below. The code for the Excel VBA Phone Book will be added as we go through the tutorials. This project will work with Excel 2003 / 2007 / 2010.

Goal: Develop skills in application development.

Here is a image of the hidden database for the Excel VBA Phone Book

Features of the Excel VBA Phone Book Filter contacts by all headings Filter by full or part references Data is auto sorted Add data is indexed so no duplicates Add new contacts from the form Delete contacts Edit all or part of the database

What will we learn? Recording macros Working with variables

Functions /IF / SORT / OFFSET Variable advanced filters Copy and paste without selecting Application logic

Watch this video to seen the features of the Excel VBA Phone Book in action. http://www.youtube.com/watch?v=kwDEFvDVu_E

Simply the Best Phone Book - Contact Manager: Part 2 Simply the Best Phone Book - Part2 Video 2 - Excel VBA Phone Book https://www.youtube.com/watch?v=eEVkPCTFcgU

Modifying the template The template is formatted for you completely. I contains 2 worksheets. Name them what ever you want. It will not effect the running of the phone book. I have left the navigation buttons with the hyperlinks attached and a small piece of code to open the userform. If you were to open the Name Manager( Formula tab / Name manager) here are the named ranges included in the template. ID =phonelist!$A$1 This is for the hyperlink to the database outdata =OFFSET(phonelist!$N$9,0,0,COUNTA(phonelist!$N$9:$N$10000),7) This is a dynamic named range to pick up the filtered data and add it to the userform. Please Note: If you copy and paste these formulas Excel may view them as text and add =" formula ". If this occurs type the named range in or remove the double quotes after you paste. Dynamic Named Ranges add Power and Punch Start =Interface!$A$1 This is for the hyperlink to the Interface When ever you run an advanced filter Microsoft Excel adds the named ranges for the Criteria and the Extract. Don't worry about these.

In this tutorial I will show you how to run and record the advanced filter and then to run the macro from a keyboard shortcut.

Here is the basic breakdown of how advanced filters work. Firstly, where do we locate the advanced filter tab? On the ribbon click the Data tab and then click Advanced. See illustration below

Dialog box options for advanced filters

1) When you click the advanced button a dialogue box appears giving you the several options let’s have a look at what those options are. Under the category Action you will notice 2 radio buttons. If you wish to filter the data set itself or in place then click the top button. 2) If you wish to filter to another location whether that be on the same worksheet or and other worksheet you would click Copy to another location. It is very important to remember that if you wish to have the data filtered to another sheet then you must start this process from that sheet. 3)

You now have three boxes

i)

List range

ii)

Criteria range

iii) Copy to 4) To set these three ranges you need to first click inside the box until you see your cursor inside the box. That tells Microsoft Excel that that is the area you wish to now edit. 5) Enter the range manually or click the red arrow and scroll over the range for that particular section. 6) If you wish only to filter unique records and this can be a very valuable asset if you are looking for specific data in large data sets then clicks the button unique records.

The List range The list range must include the heading along with all of the data. There should not be any blank rows in your data. And it is best to surround the data set with blank columns and rows so that Microsoft Excel can recognise this as a data list. The Criteria range. The criteria range should include both the header and that the criteria with no spaces. It is possible to filter with multiple criteria and with operators such as greater than >/ less than parameters for your criteria. You can also filter between two sets of criteria such as greater than> /and less than.

Here are the 3 steps for this project's advanced filter

Record the advanced filter Now lets run the advanced filter and record it as we go. Click on the Developer tab. If you can not see the Developer tab click File/ Options / Customise the ribbon /in the right hand tab tick the box next to Developer. Now click Record Macro and the macro dialog box will appear. Give the macro a name (one word or multiple words joined with underscores) make sure theStore macro in: is This Workbook.

Push the cap lock on your keyboard and in Shortcut Key: type a letter choose a letter ,let's say A. Now we can run the macro by holding down Ctrl+ Shift+A. This makes testing easy. Here is your challenge. Run the advanced filter and then stop recording the macro. Now push Ctrl+ Shift+A to run the advanced filter. Test it by changing the criteria header and criteria. [box]

This is what the recorded macro should look like Sub Advanced_Filter() ' ' Advanced_Filter Macro ' ' Keyboard Shortcut: Ctrl+Shift+A ' Range("B8:H204").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "phonelist!Criteria"), CopyToRange:=Range("phonelist!Extract"), Unique:= _ False End Sub [/box]

The Userform The userform is also fully formatted with the controls named appropriate to the code that will be added as we go. If it is for example a textbox for searching I would name it txtSearch a command button to close the form would be cmdClose. This will make the code easier to read then TextBox1 or CommandButton1. With the ListBox it is important to make sure that the Properties are set for BoundColumns 1 ColumnCount 6 ColumnWidth 80pt;80pt;80pt;80pt;80pt;80pt(change the sizes to suit the widths)

Simply the Best Phone Book - Contact Manager: Part 3 Simply the Best Phone Book - Part3 Video 3 - Excel VBA Phone Book. Adding the advanced filter to the userform. http://www.youtube.com/watch?v=7OpZjkwo1NU Part 3: Adding the advanced filter to the Userform.

How are we going to have the data in our database referenced as it grows and shrinks? There are 3 ways that I know of to do this. 1. Use a dynamic named range 2. Set a static named range every time we run the procedure. 3. Use CurrentRegion It is possible in some situations that the database may be very large so I would not recommend a dynamic named range. To set a static named range as the procedure is run would work but by far the simplest and most effective method is to use Current Region. To have a brief look at how this works: click anywhere in your data then on the Home tab select Find and Select on the right hand side then choose go to Special and tick the Current Region option button. If you were to record this action in code you would see this: Sub Macro1() Selection.CurrentRegion.Select End Sub Let’s add this to our Advanced filter module.

We will set a variable for the sheet name and add CurrentRegion Set DataSH = Sheet1 DataSH.Range("B8").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "phonelist!Criteria"), CopyToRange:=Range("phonelist!Extract"), Unique:= _ False

Adding the code to the userform We can now take this code and add it straight in to the PhoneList Userform. Press Alt+F11 to open the VBE and double click on the Userform. Double click on the command button Get Contacts and paste your code in to the Private Sub cmdContact_Click() Put the code here End Sub

Make it flexible Now we want to be able to change the advanced filter criteria from the Userform so we will have full filtering control. First we need to add the criteria headers to the ComboBox (cboSelect) Open the Userform in the VBE and right click the userform and choose View Code. O the top right hand corner click the drop down arrow for the events associated with the Userform, select “Initialze”

Add this code. Private Sub UserForm_Initialize() Me.cboSelect.List = WorksheetFunction.Transpose(Sheet1.Range("B8:G8")) End Sub This will add the headers form the database (CriteriaHeaders) to the ComboBox. Now lets set 2 variables for the criteria header and the criteria.

Under “Set DataSH = Sheet1” add the code below DataSH.Range("L8") = Me.cboSelect.Value DataSH.Range("L9") = Me.txtSearch.Text

Adding data to the ListBox To add our filtered data to the Userform add the code shown here. This code says add the dynamic range “outdata” as the RowSource for the listbox. The range “outdata” is included in your template. ListBox1.RowSource = Sheet1.Range("outdata").Address(external:=True) I have also put in some error handling so now your completed Get Contact procedure will look like this.

This is how the finalised code should look Private Sub cmdContact_Click() Dim DataSH As Worksheet On Error GoTo cmdContact_Click_Error On Error GoTo errhandler: Set DataSH = Sheet1 DataSH.Range("L8").Value = cboSelect.Value DataSH.Range("L9").Value = txtSearch.Text DataSH.Range("B8").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=DataSH.Range("L8:L9") _ , CopyToRange:=DataSH.Range("N8:T8") 'Set myRng = Sheet1.Range("outdata") ListBox1.RowSource = Sheet1.Range("outdata").Address(external:=True) Exit Sub errhandler: MsgBox "No match found for " & txtSearch.Text On Error GoTo 0 Exit Sub 'if error occurs then show me exactly where the error occurs cmdContact_Click_Error: MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cmdContact_Click of Form PhoneList" End Sub

Set the Close button Before we conclude this section we are going to add the code to close the PhoneList Userform.

Double click on the close button (cmdClose) in the VBE and Add Unload me So now we can run our Userform from the interface and our filtered data will appear in the form. We can also filter the database with any of the header criteria.

Simply the Best Phone Book - Contact Manager: Part 4 Simply the Best Phone Book - Part4 Video 4 - Excel VBA Phone Book. Adding new contacts. http://www.youtube.com/watch?v=Io5kB1BhCdw Adding the information from the PhoneList Userform to the database is what we are going to look at now. Open the VBE and double click on the Phonelist. Double click on Add Contacts button. This is what you will see. Private Sub cmdAdd_Click() End Sub Our goal is to take the information from the six text boxes at the bottom of the Userform and transfer it to the database at the bottom of the list. 1. 2. 3. 4. 5.

add data to the bottom add a new index number sort our contacts sort our index numbers when a contact is double clicked we want the information added to the text boxes

1. add data to the bottom Add this code to the sub 'set the destination range Set Drng = Sheet1.Range("b8") 'move the values without selecting Drng.End(xlDown).Offset(1, 0).Value = Me.txtSurname.Value Drng.End(xlDown).Offset(0, 1).Value = Me.txtFirstName.Value Drng.End(xlDown).Offset(0, 2).Value = Me.txtAddress.Value Drng.End(xlDown).Offset(0, 3).Value = Me.txtPhone.Value Drng.End(xlDown).Offset(0, 4).Value = Me.txtMobile.Value Drng.End(xlDown).Offset(0, 5).Value = Me.txtEmail.Value

The breakdowns of this code is start at sheet1 range B8 and go down until we find the last value the offset 1 row and add the value from the surname text box. Then go down the column again and find this new value and offset 1 column and add the value from the First Name text box. We the repeat this for the remaining text boxes and offset an extra column each time. Add this code and test it from the Userform. Add some values into the text boxes and click Add Contact You will notice that this all occurs without actually going to the database. 2.

Adding the index number

Add this piece of code to the bottom to add the new index number. Drng.End(xlDown).Offset(0, 6).Value = Drng.End(xlDown).Offset(-1, 6).Value + 1 Test this in your application. 3. Sort our contacts 4.Sort the index numbers We are going to put the sort code into a module and call it from the Userform procedure. Double click on the module called PhoneBook Add a sub called Sortit Sub Sortit() With Sheet1 'sort the phone list .Range("B9:G10000").Sort Key1:=.Range("B9"), Order1:=xlAscending, Header:=xlNo 'sort the index numbers .Range("H9:H10000").Sort Key1:=.Range("H9"), Order1:=xlAscending, Header:=xlNo End With End Sub This code will work without selecting the sheet. I would suggest that you use this rather than record the actions and use the recorded code. Here is the completed sort code with error handling Sub Sortit() 'error handler On Error GoTo Sortit_Error 'sort the phone list

With Sheet1 .Range("B9:G10000").Sort Key1:=.Range("B9"), Order1:=xlAscending, Header:=xlNo 'sort the index numbers .Range("H9:H10000").Sort Key1:=.Range("H9"), Order1:=xlAscending, Header:=xlNo End With 'reset error On Error GoTo 0 Exit Sub 'if error occurs then show me exactly where the error occurs Sortit_Error: MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Sortit of Module PhoneBook" End Sub Test your application to see that all is working fine. Here is the completed add contact code with error handling and a confirmation message box. I have also included an IF statement to make sure data is in the text boxes before we permit the information to be sent. [box] Private Sub cmdAdd_Click() On Error GoTo cmdAdd_Click_Error 'make sure that there is data to add If Me.txtSurname.Value = "" _ Or Me.txtFirstName.Value = "" _ Or Me.txtAddress.Value = "" _ Or Me.txtPhone.Value = "" Then Call MsgBox("The fields are not complete", vbInformation, "Edit Contact") Exit Sub End If 'set the destination range Set Drng = Sheet1.Range("b8") 'move the values without selecting Drng.End(xlDown).Offset(1, 0).Value = Me.txtSurname.Value Drng.End(xlDown).Offset(0, 1).Value = Me.txtFirstName.Value Drng.End(xlDown).Offset(0, 2).Value = Me.txtAddress.Value Drng.End(xlDown).Offset(0, 3).Value = Me.txtPhone.Value Drng.End(xlDown).Offset(0, 4).Value = Me.txtMobile.Value Drng.End(xlDown).Offset(0, 5).Value = Me.txtEmail.Value Drng.End(xlDown).Offset(0, 6).Value = Drng.End(xlDown).Offset(-1, 6).Value + 1 'give the "all OK signal" Call MsgBox("A new contact has been added", vbInformation, "Add Contact") 'sort the data Sortit On Error GoTo 0 Exit Sub 'if error occurs then show me exactly where the error occurs

cmdAdd_Click_Error: MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cmdAdd_Click of Form PhoneList" End Sub [/box] 5.

when a contact is double clicked we want the information added to the text boxes

Adding data to the editing area of the userform When we double click on a contact we want the information to be added at the bottom of the Userform in the 6 text boxes. Open the VBE and double click on the userform then right click and select View code In the events window in the top right hand corner choose DblClick This is what you will see. Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) End Sub Add this to the sub Me.txtSurname.Value = Me.ListBox1.Value Me.txtFirstName.Value = Me.ListBox1.Column(1) Me.txtAddress.Value = Me.ListBox1.Column(2) Me.txtPhone.Value = Me.ListBox1.Column(3) Me.txtMobile.Value = Me.ListBox1.Column(4) Me.txtEmail.Value = Me.ListBox1.Column(5) Me.txtID.Value = Me.ListBox1.Column(6) When we are editing or deleting the one thing we do not want to happen is to add because this will cause a duplicate contact to be added to the database. Not a good thing. So add this piece of code as well Me.cmdAdd.Enabled = False This will disable the Add Contact button This this code in your application. When you double click a contact in the listbox it will now be added to the 6 text boxes at the bottom of the form. Here is the completed code

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) 'error handler On Error GoTo ListBox1_DblClick_Error 'stop a duplicate from being added Me.cmdAdd.Enabled = False 'allow editing Me.cmdEdit.Enabled = True 'send data to the bottom of the form for editing Me.txtSurname.Value = Me.ListBox1.Value Me.txtFirstName.Value = Me.ListBox1.Column(1) Me.txtAddress.Value = Me.ListBox1.Column(2) Me.txtPhone.Value = Me.ListBox1.Column(3) Me.txtMobile.Value = Me.ListBox1.Column(4) Me.txtEmail.Value = Me.ListBox1.Column(5) Me.txtID.Value = Me.ListBox1.Column(6) On Error GoTo 0 Exit Sub 'if error occurs then show me exactly where the error occurs ListBox1_DblClick_Error: MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure ListBox1_DblClick of Form PhoneList" End Sub

Simply the Best Phone Book - Contact Manager: Part 5 Simply the Best Phone Book - Part 5 We will be adding the code behind these 4 buttons. Add / Edit / Delete / Clear http://www.youtube.com/watch?v=9pCcJ3XaYmI

Add (reset) Code This really just a reset button. The red code below is the part of the code that is doing the work. The rest is error handling amd a message box. Unload Me PhoneList.Show PhoneList.cmdEdit.Enabled = False [box] Private Sub cmdSet_Click() 'error handler On Error GoTo cmdSet_Click_Error 'reset the form by unload and then reload Unload Me PhoneList.Show 'stop edits because we are adding a contact

PhoneList.cmdEdit.Enabled = False 'confirmation "All OK" message MsgBox "You can now Add a contact", vbInformation, "Add New Contact" 'reset error On Error GoTo 0 Exit Sub 'if error occurs then show me exactly where the error occurs cmdSet_Click_Error: MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cmdSet_Click of Form PhoneList" End Sub [/box]

Edit Code All that is happening here is we are referencing the index number on the userform and finding it in the database. Then we simply offset to each column and add the values from the 6 text boxes on the userform. Set findvalue = Sheet1.Range("h8:h10000").Find(What:=Me.txtID, LookIn:=xlValues) [box] Private Sub cmdEdit_Click() 'error handler On Error GoTo cmdEdit_Click_Error 'check that there is data to edit If Me.txtID = "" Then Call MsgBox("The fields are not complete", vbInformation, "Edit Contact") Exit Sub End If 'find the value in case of duplicates we use an ID 'Sheet1.Range("a1") = txtID.Value Set findvalue = Sheet1.Range("h8:h10000").Find(What:=Me.txtID, LookIn:=xlValues) 'findvalue.Value = Me.txtID "we do not want to edit the ID" findvalue.Offset(0, -1).Value = Me.txtEmail.Value findvalue.Offset(0, -2).Value = Me.txtMobile.Value findvalue.Offset(0, -3).Value = Me.txtPhone.Value findvalue.Offset(0, -4).Value = Me.txtAddress.Value findvalue.Offset(0, -5).Value = Me.txtFirstName.Value findvalue.Offset(0, -6).Value = Me.txtSurname.Value Call MsgBox("The contact has been updated", vbInformation, "Edit Contact") 'reset error On Error GoTo 0

Exit Sub 'if error occurs then show me exactly where the error occurs cmdEdit_Click_Error: MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cmdEdit_Click of Form PhoneList" End Sub [/box]

Delete Code All that is happening here is we are referencing the index number on the userform and finding it in the database. Then we simply offset to each column and an make the value "" (nothing) in 7 text boxes on the userform. Then the sort macro is called to remove the blank row. Private Sub cmdDelete_Click() On Error GoTo cmdDelete_Click_Error If txtSurname = "" Then Call MsgBox("Double click the contact so it can be deleted", vbInformation, "Delete Contact") Exit Sub End If Select Case MsgBox("You are about to delete a contact." _ & vbCrLf & "Do you want to proceed?" _ , vbYesNo Or vbQuestion Or vbDefaultButton1, "Are you sure about this") Case vbYes Case vbNo End Select 'Sheet1.Range("a1") = txtID.Value Set findvalue = Sheet1.Range("h8:h10000").Find(What:=Me.txtID, LookIn:=xlValues) findvalue.Value = "" findvalue.Offset(0, -1).Value = "" findvalue.Offset(0, -2).Value = "" findvalue.Offset(0, -3).Value = "" findvalue.Offset(0, -4).Value = "" findvalue.Offset(0, -5).Value = "" findvalue.Offset(0, -6).Value = "" ClearList Sortit On Error GoTo 0 Exit Sub 'if error occurs then show me exactly where the error occurs cmdDelete_Click_Error:

MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cmdDelete_Click of Form PhoneList" End Sub

Clear Code In case you type in information and need to delete it I have added a clear button that sets all the values to "" (nothing). You could also just reset the form with this code instead. Unload me PhoneList.Show [box] Private Sub cmdClear_Click() 'error handler On Error GoTo cmdClear_Click_Error 'clear the top of form Me.cboSelect = "" Me.txtSearch = "" Me.ListBox1.RowSource = "" 'clear the bottom of form ClearList 'reset the error On Error GoTo 0 Exit Sub 'if error occurs then show me exactly where the error occurs cmdClear_Click_Error: MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cmdClear_Click of Form PhoneList" End Sub