Private Sub cmdAddCompetitor_Click()
Dim lRow As Long
Dim ws As Worksheet
Set ws = Worksheets("Database")
Dim cStartCell As Range
Dim n As Long, lastRow As Long
Dim manufacturer As String
Dim Competitorname As String
Dim i As Long
'find first empty row in database
lRow = ws.Cells.Range("A" & Rows.Count).End(xlUp).Row + 1
'checks for a competitor name value
If Trim(Me.txtCompName.Value) = "" Then
Me.txtCompName.SetFocus
MsgBox "Please enter a Competitors Name"
Exit Sub
End If
If WorksheetFunction.CountIf(ws.Range("A:A"), txtCompName.Value) = 0 And WorksheetFunction.CountIf(ws.Range("B:B"), cboCountry.Value) = 0 Then
'copy the data to the database
With ws
.Cells(lRow, 1).Value = Me.txtCompName.Value
.Cells(lRow, 2).Value = Me.cboCountry.Value
.Cells(lRow, 3).Value = Me.txtStreet.Value
.Cells(lRow, 4).Value = Me.txtCity.Value
.Cells(lRow, 5).Value = Me.txtPobox.Value
.Cells(lRow, 6).Value = Me.txtPhone.Value
.Cells(lRow, 7).Value = Me.txtEmail.Value
.Cells(lRow, 8).Value = Me.txtWeb.Value
.Cells(lRow, 9).Value = Me.cboType.Value
.Cells(lRow, 10).Value = Me.txtAgent.Value
.Cells(lRow, 11).Value = Me.txtDep1.Value
.Cells(lRow, 12).Value = Me.txtDep2.Value
.Cells(lRow, 13).Value = Me.txtDep3.Value
.Cells(lRow, 14).Value = Me.txtContactName1.Value
.Cells(lRow, 15).Value = Me.txtContactMobile1.Value
.Cells(lRow, 16).Value = Me.txtContactEmail1.Value
.Cells(lRow, 17).Value = Me.cboContactDesig1.Value
.Cells(lRow, 18).Value = Me.txtContactName2.Value
.Cells(lRow, 19).Value = Me.txtContactMobile2.Value
.Cells(lRow, 20).Value = Me.txtContactEmail2.Value
.Cells(lRow, 21).Value = Me.cboContactDesig2.Value
.Cells(lRow, 22).Value = Me.txtContactName3.Value
.Cells(lRow, 23).Value = Me.txtContactMobile3.Value
.Cells(lRow, 24).Value = Me.txtContactEmail3.Value
.Cells(lRow, 25).Value = Me.cboContactDesig3.Value
.Cells(lRow, 26).Value = Me.txtContactName4.Value
.Cells(lRow, 27).Value = Me.txtContactMobile4.Value
.Cells(lRow, 28).Value = Me.txtContactEmail4.Value
.Cells(lRow, 29).Value = Me.cboContactDesig4.Value
.Cells(lRow, 30).Value = Me.txtContactName5.Value
.Cells(lRow, 31).Value = Me.txtContactMobile5.Value
.Cells(lRow, 32).Value = Me.txtContactEmail5.Value
.Cells(lRow, 33).Value = Me.cboContactDesig5.Value
.Cells(lRow, 34).Value = Me.txtPrevRevPower.Value
.Cells(lRow, 35).Value = Me.txtPowermVA.Value
.Cells(lRow, 36).Value = Me.txtPowerRate.Value
.Cells(lRow, 37).Value = Me.txtPowerUtil.Value
.Cells(lRow, 38).Value = Me.txtPrevRevTC.Value
.Cells(lRow, 39).Value = Me.txtTCTR.Value
.Cells(lRow, 40).Value = Me.txtTCRate.Value
.Cells(lRow, 41).Value = Me.txtTCUtil.Value
'This code adds the manufacturer list box selection into cell AP
For i = 1 To lstManufacturersSelection.ListCount
manufacturer = manufacturer & lstManufacturersSelection.List(i - 1) & ","
Next
If Len(manufacturer) > 0 Then
ActiveSheet.Cells(lRow, "AP") = Left(manufacturer, Len(manufacturer) - 1)
Else
ActiveSheet.Cells(lRow, "AP") = ""
End If
'Key Customer Page
'Key Customer 1
.Cells(lRow, 43).Value = Me.txtCustName1.Value
.Cells(lRow, 44).Value = Me.txtPriContact1.Value
.Cells(lRow, 45).Value = Me.txtPriContactMobile1.Value
.Cells(lRow, 46).Value = Me.txtPriContactEmail1.Value
.Cells(lRow, 47).Value = Me.cboPriDesig1.Value
.Cells(lRow, 48).Value = Me.txtSecContact1.Value
.Cells(lRow, 49).Value = Me.txtSecContactMobile1.Value
.Cells(lRow, 50).Value = Me.txtSecContactEmail1.Value
.Cells(lRow, 51).Value = Me.cboSecDesig1.Value
.Cells(lRow, 52).Value = Me.txtContractValue1.Value
.Cells(lRow, 53).Value = Me.txtContractMths1.Value
'This is where Date Picker1 add's the renewal date
.Cells(lRow, 55).Value = Me.txtContractPower1.Value
.Cells(lRow, 56).Value = Me.txtContractTC1.Value
'Key Customer 2
.Cells(lRow, 57).Value = Me.txtCustName2.Value
.Cells(lRow, 58).Value = Me.txtPriContact2.Value
.Cells(lRow, 59).Value = Me.txtPriContactMobile2.Value
.Cells(lRow, 60).Value = Me.txtPriContactEmail2.Value
.Cells(lRow, 61).Value = Me.cboPriDesig2.Value
.Cells(lRow, 62).Value = Me.txtSecContact2.Value
.Cells(lRow, 63).Value = Me.txtSecContactMobile2.Value
.Cells(lRow, 64).Value = Me.txtSecContactEmail2.Value
.Cells(lRow, 65).Value = Me.cboSecDesig2.Value
.Cells(lRow, 66).Value = Me.txtContractValue2.Value
.Cells(lRow, 67).Value = Me.txtContractMths2.Value
'This is where Date Picker2 add's the renewal date
.Cells(lRow, 69).Value = Me.txtContractPower2.Value
.Cells(lRow, 70).Value = Me.txtContractTC2.Value
'Key Customer 3
.Cells(lRow, 71).Value = Me.txtCustName3.Value
.Cells(lRow, 72).Value = Me.txtPriContact3.Value
.Cells(lRow, 73).Value = Me.txtPriContactMobile3.Value
.Cells(lRow, 74).Value = Me.txtPriContactEmail3.Value
.Cells(lRow, 75).Value = Me.cboPriDesig3.Value
.Cells(lRow, 76).Value = Me.txtSecContact3.Value
.Cells(lRow, 77).Value = Me.txtSecContactMobile3.Value
.Cells(lRow, 78).Value = Me.txtSecContactEmail3.Value
.Cells(lRow, 79).Value = Me.cboSecDesig3.Value
.Cells(lRow, 80).Value = Me.txtContractValue3.Value
.Cells(lRow, 81).Value = Me.txtContractMths3.Value
'This is where Date Picker3 add's the renewal date
.Cells(lRow, 83).Value = Me.txtContractPower2.Value
.Cells(lRow, 84).Value = Me.txtContractTC2.Value
'Additional Details Page'
.Cells(lRow, 85).Value = Me.txtASMBasic.Value
.Cells(lRow, 86).Value = Me.txtASMCommission.Value
.Cells(lRow, 87).Value = Me.txtASMAllowances.Value
.Cells(lRow, 88).Value = Me.txtASMOther.Value
.Cells(lRow, 89).Value = Me.txtSMBasic.Value
.Cells(lRow, 90).Value = Me.txtSMCommission.Value
.Cells(lRow, 91).Value = Me.txtSMAllowances.Value
.Cells(lRow, 92).Value = Me.txtSMOther.Value
.Cells(lRow, 93).Value = Me.txtSEBasic.Value
.Cells(lRow, 94).Value = Me.txtSECommission.Value
.Cells(lRow, 95).Value = Me.txtSEAllowances.Value
.Cells(lRow, 96).Value = Me.txtSEOther.Value
.Cells(lRow, 97).Value = Me.txtServEngBasic.Value
.Cells(lRow, 98).Value = Me.txtServEngCommission.Value
.Cells(lRow, 99).Value = Me.txtServEngAllowances.Value
.Cells(lRow, 100).Value = Me.txtServEngOther.Value
.Cells(lRow, 101).Value = Me.txtAdditionalNotes.Value
End With
'clear the data
'competitorname = Me.txtCompName.Value = ""
'This line sorts the competitors into alphbetical order
Columns("A:EZ").Sort Key1:=Range("A1:EZ100"), Order1:=xlAscending, Header:=xlYes
'Msg to say Competitor added
MsgBox "You have succesfully added " & Me.txtCompName.Value & " to the Competitor Database."
End Sub
Bookmarks