MS Excel: Create a control screen to maintain data on another sheet in Excel 2003/XP/2000/97

Question: In Excel 2003/XP/2000/97, 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