MS Excel 2003: Create a control screen to maintain data on another sheet
This Excel tutorial explains how to write a macro to create a control screen to maintain data on another sheet in Excel 2003 and older versions (with screenshots and step-by-step instructions).
Question: In Microsoft 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 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
Advertisements