Option Explicit
Private Sub ComboBox1_Change()
ComboBox1 = (ComboBox1)
ComboBox1 = Evaluate("=PROPER(" & """" & ComboBox1 & """" & ")")
End Sub
Private Sub ComboBox2_Change()
On Error Resume Next
ComboBox2 = (ComboBox2)
Dim MyRange As Range
Dim noA As Integer
ListBox1.Clear
noA = WorksheetFunction.CountA(Sheets("Telefon").Range("B:B"))
For Each MyRange In Sheets("Telefon").Range("B3:B" & noA)
If Left(LCase(MyRange), Len(ComboBox2)) = LCase(ComboBox2) Then ListBox1.AddItem (MyRange)
Next
End Sub
Private Sub CommandButton1_Click()
On Error Resume Next
Sheets("Telefon").Select
Dim bak As Range '****
Dim say As Integer
''''''''''''''''''''''''
For Each bak In Range("B1:B" & WorksheetFunction.CountA(Range("B1:B65000")))
If StrConv(bak.Value, vbUpperCase) = StrConv(ComboBox1.Value, vbUpperCase) Then
MsgBox "This person exists."
Exit Sub
End If
Next bak
say = WorksheetFunction.CountA(Range("B1:B65500"))
'TextBox1.Value = say
Cells(say + 4, 4).Value = TextBox1.Value
Cells(say + 4, 2).Value = ComboBox1.Value
Cells(say + 4, 5).Value = ComboBox3.Value
Cells(say + 4, 3).Value = TextBox17.Value
Cells(say + 4, 6).Value = TextBox2.Value
Cells(say + 4, 7).Value = ComboBox4.Value
Cells(say + 4, 8).Value = TextBox3.Value
Cells(say + 4, 9).Value = TextBox4.Value
Cells(say + 4, 10).Value = TextBox5.Value
Cells(say + 4, 11).Value = TextBox6.Value
Cells(say + 4, 12).Value = TextBox7.Value
Cells(say + 4, 13).Value = TextBox8.Value
Cells(say + 4, 14).Value = TextBox9.Value
Cells(say + 4, 15).Value = TextBox10.Value
Cells(say + 4, 16).Value = TextBox11.Value
Cells(say + 4, 17).Value = TextBox12.Value
Cells(say + 4, 18).Value = TextBox13.Value
Cells(say + 4, 19).Value = TextBox14.Value
Cells(say + 4, 20).Value = TextBox15.Value
Cells(say + 4, 21).Value = TextBox16.Value
MsgBox "New entry was succesfull", vbInformation, "From " & Application.UserName
Range("A2:A65500").Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
'************************
Range("B5:U65500").Select
Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("B2").Select '*********
TextBox1.Value = WorksheetFunction.Count(Range("A1:A65500")) + 1
CommandButton5_Click
ComboBox2_Change
ComboBox1.SetFocus
Unload UserForm3
UserForm3.Show
End Sub
Private Sub CommandButton13_Click()
On Error Resume Next
If MsgBox("Close This Program?", vbYesNo, "Attention!") = vbNo Then Exit Sub
MsgBox "The data are entered and the program will close", vbCritical
Unload UserForm3
Workbooks("Clever.xls").Save ''''''''''''''''''''''''''''''''''''
Application.Visible = True
Application.Quit
End Sub
Private Sub CommandButton2_Click()
Application.Visible = True
Unload UserForm3
End Sub
Private Sub CommandButton3_Click()
End Sub
Private Sub CommandButton5_Click()
TextBox17.Value = ""
ComboBox1.Value = ""
ComboBox2.Value = ""
ComboBox3.Value = ""
ComboBox4.Value = ""
TextBox1.Value = ""
TextBox2.Value = ""
TextBox3.Value = ""
TextBox4.Value = ""
TextBox5.Value = ""
TextBox6.Value = ""
TextBox7.Value = ""
TextBox8.Value = ""
TextBox9.Value = ""
TextBox10.Value = ""
TextBox11.Value = ""
TextBox12.Value = ""
TextBox13.Value = ""
TextBox14.Value = ""
TextBox15.Value = ""
TextBox16.Value = ""
CommandButton5.Enabled = False
CommandButton94.Enabled = False
CommandButton62.Enabled = False
CommandButton1.Enabled = True
ComboBox1.SetFocus
End Sub
Private Sub CommandButton60_Click()
MsgBox "MyMessageBox"
End Sub
Private Sub CommandButton62_Click()
On Error Resume Next
Sheets("Telefon").Select
Dim MyRange As Range
Dim bos As Range
For Each bos In Range("B3:B" & WorksheetFunction.CountA(Range("B3:B65000")))
Next bos
If MsgBox("Gewählten Eintrag ändern?", vbQuestion + vbYesNo, "Attention") = vbYes Then
If TextBox1 = "" Or ComboBox1 = "" Then
MsgBox "Choose a new entry please"
Else
ActiveCell.Offset(0, 0).Value = ComboBox1.Value
ActiveCell.Offset(0, 3).Value = ComboBox3.Value
ActiveCell.Offset(0, 4).Value = TextBox2.Value
ActiveCell.Offset(0, 2).Value = TextBox1.Value
ActiveCell.Offset(0, 5).Value = ComboBox4.Value
ActiveCell.Offset(0, 6).Value = TextBox3.Value
ActiveCell.Offset(0, 7).Value = TextBox4.Value
ActiveCell.Offset(0, 8).Value = TextBox5.Value
ActiveCell.Offset(0, 9).Value = TextBox6.Value
ActiveCell.Offset(0, 10).Value = TextBox7.Value
ActiveCell.Offset(0, 11).Value = TextBox8.Value
ActiveCell.Offset(0, 12).Value = TextBox9.Value
ActiveCell.Offset(0, 13).Value = TextBox10.Value
ActiveCell.Offset(0, 14).Value = TextBox11.Value
ActiveCell.Offset(0, 15).Value = TextBox12.Value
ActiveCell.Offset(0, 16).Value = TextBox13.Value
ActiveCell.Offset(0, 17).Value = TextBox14.Value
ActiveCell.Offset(0, 18).Value = TextBox15.Value
ActiveCell.Offset(0, 19).Value = TextBox16.Value
ActiveCell.Offset(0, 1).Value = TextBox17.Value
MsgBox "" & ComboBox1.Value & " will be refreshed.", vbInformation, "Adress- und Telefonbook"
ListBox1.Clear
End If
For Each MyRange In Sheets("Telefon").Range("B4:B" & Range("B65536").End(xlUp).Row)
ListBox1.AddItem (MyRange)
ListBox1.List(ListBox1.ListCount - 1, 1) = MyRange.Offset(0, 1).Value
ListBox1.List(ListBox1.ListCount - 1, 2) = MyRange.Offset(0, 2).Value
ListBox1.List(ListBox1.ListCount - 1, 3) = MyRange.Offset(0, 3).Value
Next
End If
End Sub
Private Sub CommandButton94_Click()
On Error Resume Next
Sheets("Telefon").Select
If TextBox1.Text = "sira no" Then
MsgBox "This ID can't be deleted", , "Deleting failure!!!"
Exit Sub
End If
Dim say As Integer
Dim i As Integer
Dim bos As Range
For Each bos In Range("B1:B" & WorksheetFunction.CountA(Range("B1:B65000")))
If ComboBox1.Value = "" Or bos = "" Or ActiveCell = "" Then
MsgBox "Bitte zuerst Suchen"
Exit Sub
End If
Next bos
If MsgBox("Delete this entry?", vbQuestion + vbYesNo, "Attention") = vbYes Then
Range(ActiveCell.Offset(0, -1).Address(False, False) & ":" & ActiveCell.Offset(0, 20).Address(False, False)).Delete Shift:=xlUp
MsgBox " " & ComboBox1.Value & " is deleted.", vbInformation, "Adress- und Telefonbook"
say = WorksheetFunction.CountA(Range("A2:A65500"))
For i = 1 To say
Cells(i + 1, 1) = i
Next i
TextBox1.Value = WorksheetFunction.Count(Range("A1:A65500")) + 1
CommandButton5_Click
ComboBox2_Change
ComboBox1.SetFocus
Unload UserForm3
UserForm3.Show
End If
End Sub
Private Sub CommandButton95_Click()
Sheets("Telefon").Select
On Error Resume Next
[aa4] = ComboBox1.Text
[ac4] = ComboBox3.Text
[ae4] = TextBox2.Text
[ag4] = ComboBox4.Text
[ac12] = TextBox3.Text
[ac8] = TextBox4.Text
[ae8] = TextBox5.Text
[ag8] = TextBox6.Text
[ae12] = TextBox7.Text
[ag12] = TextBox8.Text
[aa15] = TextBox9.Text
[aa7] = TextBox10.Text
[aa11] = TextBox11.Text
[ac15] = TextBox12.Text
[aa18] = TextBox13.Text
[ae15] = TextBox14.Text
[ag15] = TextBox15.Text
[aa22] = TextBox16.Text
Range("AF1:AL24").Select
ActiveSheet.PageSetup.PrintArea = "$AA$1:$AG$24"
Application.ScreenUpdating = False
Application.Visible = True
Application.ScreenUpdating = True
UserForm3.Hide
'
Sheets(Array("Telefon")).PrintPreview
Application.ScreenUpdating = False
Application.Visible = False
Application.ScreenUpdating = True
Sheets("Telefon").Select
UserForm3.Show
End Sub
Private Sub Label8_Click()
End Sub
Private Sub ListBox1_Click()
On Error Resume Next
Sheets("Telefon").Select
Dim x As Integer
x = Sheets("Telefon").Range("B:B").Cells.Find(what:=ListBox1, LookIn:=xlValues).Row
ComboBox1.Value = ListBox1
Dim MyRange As Range
Dim bak As Range
For Each bak In Range("B1:B" & WorksheetFunction.CountA(Range("B1:B65000")))
If StrConv(bak.Value, vbUpperCase) = StrConv(ComboBox1.Value, vbUpperCase) Then
bak.Select
TextBox17.Value = ActiveCell.Offset(0, 1).Value
ComboBox3.Value = ActiveCell.Offset(0, 3).Value
TextBox2.Value = ActiveCell.Offset(0, 4).Value
ComboBox4.Value = ActiveCell.Offset(0, 5).Value
TextBox1.Value = ActiveCell.Offset(0, 2).Value
TextBox4.Value = ActiveCell.Offset(0, 7).Value
TextBox5.Value = ActiveCell.Offset(0, 8).Value
TextBox6.Value = ActiveCell.Offset(0, 9).Value
TextBox7.Value = ActiveCell.Offset(0, 10).Value
TextBox3.Value = ActiveCell.Offset(0, 6).Value
TextBox8.Value = ActiveCell.Offset(0, 11).Value
TextBox9.Value = ActiveCell.Offset(0, 12).Value
TextBox10.Value = ActiveCell.Offset(0, 13).Value
TextBox11.Value = ActiveCell.Offset(0, 14).Value
TextBox12.Value = ActiveCell.Offset(0, 15).Value
TextBox13.Value = ActiveCell.Offset(0, 16).Value
TextBox14.Value = ActiveCell.Offset(0, 17).Value
TextBox15.Value = ActiveCell.Offset(0, 18).Value
TextBox16.Value = ActiveCell.Offset(0, 19).Value
ListBox1.Clear
For Each MyRange In Sheets("Telefon").Range("B4:B" & Range("B65536").End(xlUp).Row)
ListBox1.AddItem (MyRange)
ListBox1.List(ListBox1.ListCount - 1, 1) = MyRange.Offset(0, 1).Value
ListBox1.List(ListBox1.ListCount - 1, 2) = MyRange.Offset(0, 2).Value
ListBox1.List(ListBox1.ListCount - 1, 3) = MyRange.Offset(0, 3).Value
Next
CommandButton5.Enabled = True
CommandButton94.Enabled = True
CommandButton62.Enabled = True
CommandButton1.Enabled = False
Exit Sub
End If
Next bak
CommandButton5.Enabled = True
CommandButton94.Enabled = True
CommandButton62.Enabled = True
CommandButton1.Enabled = False
ComboBox2.SetFocus
End Sub
Private Sub TextBox3_Change()
If Len(TextBox3.Text) >= 15 Then TextBox3 = Left(TextBox3, 15)
If Len(TextBox3.Text) < 10 Then
TextBox3 = Replace(TextBox3, " ", "")
Else
TextBox3.Text = Format(TextBox3, "(###) ###-##-##")
End If
End Sub
Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean)
TextBox3 = Format(TextBox3, "(###) ###-##-##")
End Sub
Private Sub TextBox4_Change()
If Len(TextBox4.Text) >= 15 Then TextBox4 = Left(TextBox4, 15)
If Len(TextBox4.Text) < 10 Then
TextBox4 = Replace(TextBox4, " ", "")
Else
TextBox4.Text = Format(TextBox4, "(###) ###-##-##")
End If
End Sub
Private Sub TextBox4_Exit(ByVal Cancel As MSForms.ReturnBoolean)
TextBox4 = Format(TextBox4, "(###) ###-##-##")
End Sub
Private Sub TextBox5_Change()
If Len(TextBox5.Text) >= 15 Then TextBox5 = Left(TextBox5, 15)
If Len(TextBox5.Text) < 10 Then
TextBox5 = Replace(TextBox5, " ", "")
Else
TextBox5.Text = Format(TextBox5, "(###) ###-##-##")
End If
End Sub
Private Sub TextBox5_Exit(ByVal Cancel As MSForms.ReturnBoolean)
TextBox5 = Format(TextBox5, "(###) ###-##-##")
End Sub
Private Sub TextBox6_Change()
If Len(TextBox6.Text) >= 15 Then TextBox6 = Left(TextBox6, 15)
If Len(TextBox6.Text) < 10 Then
TextBox6 = Replace(TextBox6, " ", "")
Else
TextBox6.Text = Format(TextBox6, "(###) ###-##-##")
End If
End Sub
Private Sub TextBox6_Exit(ByVal Cancel As MSForms.ReturnBoolean)
TextBox6 = Format(TextBox6, "(###) ###-##-##")
End Sub
Private Sub TextBox7_Change()
If Len(TextBox7.Text) >= 15 Then TextBox7 = Left(TextBox7, 15)
If Len(TextBox7.Text) < 10 Then
TextBox7 = Replace(TextBox7, " ", "")
Else
TextBox7.Text = Format(TextBox7, "(###) ###-##-##")
End If
End Sub
Private Sub TextBox7_Exit(ByVal Cancel As MSForms.ReturnBoolean)
TextBox7 = Format(TextBox7, "(###) ###-##-##")
End Sub
Private Sub UserForm_Initialize()
On Error Resume Next
Dim MyRange As Range
Dim noA As Integer
noA = WorksheetFunction.CountA(Sheets("Telefon").Range("B:B"))
For Each MyRange In Sheets("Telefon").Range("B4:B" & 3 + noA)
If Left(LCase(MyRange), Len(ComboBox2)) = LCase(ComboBox2) Then ListBox1.AddItem (MyRange)
Next
ComboBox1.SetFocus
CommandButton5.Enabled = False
CommandButton94.Enabled = False
CommandButton62.Enabled = False
ComboBox3.RowSource = "Telefon!AO5:AO8"
ComboBox4.RowSource = "Telefon!AQ5:AQ100"
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode <> 1 Then Cancel = True
End Sub
I opened your HTML Maker Application from your signature but I don't know how to start it. 
