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 |