Excel: Create a control screen to maintain data on another sheet


Question:  In Excel, I have data on Sheet1 that contains a master list of customers. I'd like to be able to create a sort of control screen on another sheet that allows me to make changes, add new customers, and delete existing customers from this master list.


How can I do this?


Answer:  This can be done with macro code.


Let's take a look at an example.


Download Excel spreadsheet (as demonstrated below)




In our spreadsheet, our data is on Sheet1. Please note that in order for this example to work, the Project number in column A must be a unique value for each row.




On Sheet2, we have three sections. The first section allows you to change customer information. If you select a customer in the combo box, you can make changes to the data in the cells that are blue, and then click on the "Save Changes" button.


The second section allows you to add a new customer. You can do this by entering the new customer data in the blue cells and then clicking on the "Add New" button. Again, please note that the Project number must always be unique for each customer.


The third section allows you to delete an existing customer. You can do this by selecting a customer from the combo box and then clicking on the "Delete" button.


You can press Alt-F11 to view the VBA code. Select the module called Module1 in the left window.


Macro Code:

The macro code looks like this:


The macro code for the "Save Changes" button:

Sub SaveChanges()


    'Update data on Sheet1 based on changes made to data on Sheet2


    Dim LProject As Integer


    Dim LAddress As String
    Dim LPhoneNbr As String


    Dim LRow As Long
    Dim LFound As Boolean


    'Retrieve project number number
    LProject = Range("E3").Value


    'Retrieve new address and phone number information
    LAddress = Range("D5").Value
    LPhoneNbr = Range("D7").Value


    'Move to Sheet1 to save the changes
    Sheets("Sheet1").Select


    LFound = False


    LRow = 2


    Do While LFound = False
        'Found matching project, now update address and phone number information
        If Range("A" & LRow).Value = LProject Then
            LFound = True
            Range("C" & LRow).Value = LAddress
            Range("D" & LRow).Value = LPhoneNbr


        'Encountered a blank project number (assuming end of list on Sheet1)
        ElseIf IsEmpty(Range("A" & LRow).Value) = True Then
            MsgBox ("No match was found. Changes were not made.")
            Exit Sub
        End If


        LRow = LRow + 1
    Loop


    'Reposition back on Sheet2
    Sheets("Sheet2").Select
    Range("D5").Select


    MsgBox ("Changes were successfully saved.")


End Sub


The macro code to populate the customer data in the "Change Customer" section:

Sub PopulateData()


    Dim LProject As Integer


    Dim LAddress As String
    Dim LPhoneNbr As String


    Dim LRow As Long
    Dim LFound As Boolean


    'Retrieve project number number
    LProject = Range("E3").Value


    'Move to Sheet1
    Sheets("Sheet1").Select


    LFound = False


    LRow = 2


    Do While LFound = False
        'Found matching project, now update address and phone number information on Sheet2
        If Range("A" & LRow).Value = LProject Then
            LFound = True
            LAddress = Range("C" & LRow).Value
            LPhoneNbr = Range("D" & LRow).Value


            Sheets("Sheet2").Select
            Range("D5").Value = LAddress
            Range("D7").Value = LPhoneNbr


        'Encountered a blank project number (assuming end of list on Sheet1)
        ElseIf IsEmpty(Range("A" & LRow).Value) = True Then
            MsgBox ("No match was found for combo box selection.")
            Exit Sub
        End If

        LRow = LRow + 1
    Loop


End Sub


The macro code for the "Add New" button:

Sub AddNew()


    'Update data on Sheet1 based on new customer entered on Sheet2


    Dim LCustomer As String
    Dim LProject As Integer
    Dim LAddress As String
    Dim LPhoneNbr As String


    Dim LRow As Long
    Dim LFound As Boolean


    'Before adding new customer, make sure a value was entered
    If IsEmpty(Range("D12").Value) = False Then


        'Retrieve new information
        LCustomer = Range("D12").Value
        LProject = Range("D14").Value
        LAddress = Range("D16").Value
        LPhoneNbr = Range("D18").Value


        'Move to Sheet1 to save the changes
        Sheets("Sheet1").Select


        LFound = False


        LRow = 2


        Do While LFound = False


            'Encountered a blank project number (assuming end of list on Sheet1)
            If IsEmpty(Range("A" & LRow).Value) = True Then
                LFound = True
            End If


            LRow = LRow + 1
        Loop


        Range("A" & LRow - 1).Value = LProject
        Range("B" & LRow - 1).Value = LCustomer
        Range("C" & LRow - 1).Value = LAddress
        Range("D" & LRow - 1).Value = LPhoneNbr


        'Reposition back on Sheet2
        Sheets("Sheet2").Select


        'Update range for combo boxes
        ActiveSheet.Shapes("Drop Down 3").Select
        With Selection
            .ListFillRange = "Sheet1!$B$2:$B$" & LRow - 1
        End With


        ActiveSheet.Shapes("Drop Down 8").Select
        With Selection
            .ListFillRange = "Sheet1!$B$2:$B$" & LRow - 1
        End With


        'Clear entries from cells
        Range("D12").Value = ""
        Range("D14").Value = ""
        Range("D16").Value = ""
        Range("D18").Value = ""

        Range("D12").Select


        MsgBox ("New customer was successfully added.")
    End If


End Sub


The macro code for the "Delete" button:

Sub DeleteData()


    'Delete data on Sheet1 for customer chosen on Sheet2


    Dim LProject As Integer


    Dim LRow As Long
    Dim LFound As Boolean


    'Retrieve project number number
    LProject = Range("E23").Value


    'Move to Sheet1 to delete customer
    Sheets("Sheet1").Select


    LFound = False


    LRow = 2


    Do While LFound = False
        'Found matching project, now delete customer entry
        If Range("A" & LRow).Value = LProject Then
            LFound = True
            Rows(LRow & ":" & LRow).Select
            Selection.Delete Shift:=xlUp


        'Encountered a blank project number (assuming end of list on Sheet1)
        ElseIf IsEmpty(Range("A" & LRow).Value) = True Then
            MsgBox ("No match was found.  Delete was unsuccessful.")
            Exit Sub
        End If


        LRow = LRow + 1
    Loop


    'Reposition back on Sheet2
    Sheets("Sheet2").Select
    Range("E23").Value = ""


    MsgBox ("Customer was successfully deleted.")


End Sub

Spreadsheet News


Book Shop


Visit our busy book shop, were you can find latest books for beginners as well as advanced excel users.



Software Library




Spreadsheet123

Spreadsheet 123 Spreadsheet Software Development

Home | About Us | Our Services | Software | Spreadsheets Library | Excel Tutorials | Useful Links | Site Map | Contact Us
Home
About Us
About Spreadsheet
Book Shop
Excel Tutorials
1
Spreadsheets Library
3
4
5
6
Our Services
8
Site Map
Software
11
12
13
14
15
16
17