Searching Telephone Directory Excell VBA

VBA Code

Private Sub TextBox1_Change()
On Error Resume Next
Me.TextBox1.Text = StrConv(Me.TextBox1.Text, vbProperCase)
Me.ListBox1.Clear
Dim i As Long
For i = 2 To Application.WorksheetFunction.CountA(Sheet1.Range("A:A"))
For x = 1 To 4
a = Len(Me.TextBox1.Text)
If Left(Sheet1.Cells(i, x).Value, a) = Me.TextBox1.Text And Me.TextBox1.Text <> "" Then
Me.ListBox1.AddItem Sheet1.Cells(i, 1).Value
For c = 1 To 4
Me.ListBox1.List(ListBox1.ListCount - 1, c) = Sheet1.Cells(i, c + 1).Value
Next c
End If
Next x
Next i

End Sub

New Code With Capture Column Heds Data

Private Sub UserForm_Initialize()

Me.TextBox1.SetFocus

End Sub

Private Sub TextBox1_Change()
On Error Resume Next
Me.TextBox1.Text = StrConv(Me.TextBox1.Text, vbProperCase)
Me.ListBox1.Clear
Me.ListBox1.AddItem Sheet1.Cells(1, "A")
For B = 2 To 4
Me.ListBox1.List(ListBox1.ListCount - 1, B - 1) = Sheet1.Cells(1, B)
Next B
Me.ListBox1.Selected(0) = True
Dim i As Long
For i = 2 To Application.WorksheetFunction.CountA(Sheet1.Range("A:A"))
For x = 1 To 4
a = Len(Me.TextBox1.Text)
If Left(Sheet1.Cells(i, x).Value, a) = Me.TextBox1.Text And Me.TextBox1.Text <> "" Then
Me.ListBox1.AddItem Sheet1.Cells(i, 1).Value
For c = 1 To 4
Me.ListBox1.List(ListBox1.ListCount - 1, c) = Sheet1.Cells(i, c + 1).Value
Next c
End If
Next x
Next i
End Sub

Worksheet Data Edit From Userform EXcell VBA

Textbox Format

Private Sub TextBox1_AfterUpdate()

On Error Resume Next

Me.TextBox1 = CDate(Me.TextBox1)

End Sub

Private Sub TextBox3_AfterUpdate()

On Error Resume Next

Me.TextBox3.Value = StrConv(Me.TextBox3.Value, vbProperCase)

End Sub

Private Sub TextBox4_AfterUpdate()

On Error Resume Next

Me.TextBox4.Value = Format(Me.TextBox4.Value, "#####.00")

End Sub

Worksheet To Userform

Private Sub TextBox5_AfterUpdate()

Dim i As Long

For i = 2 To Application.WorksheetFunction.CountA(Sheet1.Range("A:A"))

For x = 1 To 4

If Sheet1.Cells(i, "B").Value = Me.TextBox5.Text Then

Me("Textbox" & x).Value = Sheet1.Cells(i, x).Value

End If

Next x

Next i

End Sub

Userform To worksheet

Private Sub CommandButton1_Click()

Dim i As Long

For i = 2 To Application.WorksheetFunction.CountA(Sheet1.Range("A:A"))

For x = 1 To 4

If Sheet1.Cells(i, "B").Value = Me.TextBox5.Text Then

Sheet1.Cells(i, x).Value = Me("Textbox" & x).Value

End If

Next x

Next i

End Sub

Worksheet Sum Runningbalance Excell VBA

Private Sub Worksheet_Change(ByVal Target As Range)

 i = Application.WorksheetFunction.CountA(Sheet1.Range("A:A"))
On Error Resume Next
Sheet1.Cells(i, "D").Value = Val(Sheet1.Cells(i - 1, "D")) + Val(Sheet1.Cells(i, "B")) _
- Val(Sheet1.Cells(i, "C"))
End Sub

Worksheet Send Data Without Duplicate Value In EXcell VBA

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long
For i = 2 To Application.WorksheetFunction.CountA(Sheet1.Range("A:A"))
a = Application.WorksheetFunction.CountIf(Sheet1.Range("B:B"), _
Sheet1.Cells(i, 1).Value)
If a = 0 Then
Sheet1.Range("B1000000").End(xlUp).Offset(1, 0).Value = Sheet1.Cells(i, 1).Value
End If
Next i
End Sub

Insert serial Number Automatically In Wortksheet Excell VBA

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
i = Application.WorksheetFunction.CountA(Sheet1.Range("B:B"))
If i > 1 Then
Sheet1.Range("A" & i).Value = i - 1
End If
End Sub

Processor Bar In Userform Excell VBA

Private Sub CommandButton1_Click()

Dim i As Long

For i = 1 To 5000 Step 3

Me.Label2.Width = Me.Label2.Width + 0.3

DoEvents

Me.Caption = i / 50 & "%"

Me.Label2.Caption = i / 50 & "%"

If Me.Label2.Width >= 300 Then

Me.Label2.BackColor = vbYellow

End If

Next i

Me.Caption = "Completed"

Me.Label2.Caption = "Completed"

Me.Label2.TextAlign = fmTextAlignCenter

End Sub

Combobox Additem From worksheet Dynamic Range Excell VBA

Combobox Fill Dynamic Range Private Sub UserForm_Initialize() Dim i As Long For i = 1 To Sheet1.Range("A1000000").End(xlUp).Offset(1, 0).Row Me.ComboBox1.AddItem Sheet1.Cells(i, 1).Value Next i End Sub

Listbox Additem From Worksheet Between Two Date Excell VBA

Private Sub TextBox1_AfterUpdate()

On Error Resume Next

Me.TextBox1 = CDate(Me.TextBox1)

End Sub

Private Sub TextBox2_AfterUpdate()

On Error Resume Next

Me.TextBox2 = CDate(Me.TextBox2)

Me.ListBox1.Clear

For i = 2 To Application.WorksheetFunction.CountA(Sheet1.Range("A:A"))

If Sheet1.Cells(i, 1).Value >= CDate(Me.TextBox1.Value) And _

Sheet1.Cells(i, 1).Value <= CDate(Me.TextBox2.Value) Then

Me.ListBox1.AddItem Sheet1.Cells(i, 1).Value

Me.ListBox1.List(ListBox1.ListCount - 1, 1) = Sheet1.Cells(i, 2).Value & ".00"

End If

Next i

End Sub

Calendar In Excell VBA Useerform

For Combobox & Textbox Private Sub UserForm_Initialize() Me.TextBox1.Value = Format(Date, "YYYY") For i = 0 To 11 a = Application.WorksheetFunction.EDate("1" & "/" & "January" & "/" & Me.TextBox1.Value, i) Me.ComboBox1.AddItem Format(a, "MMMM") Next i Me.ComboBox1.Value = Format(Date, "MMMM") End Sub Private Sub TextBox1_Change() Call ComboBox1_Change End Sub For Spinbutton Private Sub SpinButton1_SpinDown() On Error Resume Next Me.TextBox1.Value = Me.TextBox1.Value - 1 End Sub Private Sub SpinButton1_SpinUp() On Error Resume Next Me.TextBox1.Value = Me.TextBox1.Value + 1 End Sub For Listbox Private Sub ComboBox1_Change() Me.ListBox1.Clear For i = 1 To 31 On Error Resume Next Me.ListBox1.AddItem CDate(i & "/" & Me.ComboBox1.Value & "/" & Me.TextBox1.Value) Me.ListBox1.List(ListBox1.ListCount - 1, 1) = Format(CDate(i & "/" & _ Me.ComboBox1.Value & "/" & Me.TextBox1.Value), "DDDD") Next i End Sub

Listbox Capture From Other Workbook Excell VBA Userform

Private Sub UserForm_Initialize()

Dim database As Workbook, i As Long

Application.ScreenUpdating = False

Set database = Workbooks.Open(ThisWorkbook.Path & "/" & "Database.xlsm")

For i = 2 To Application.WorksheetFunction.CountA(Sheets("Sheet1").Range("A:A"))

Me.ListBox1.AddItem Sheets("Sheet1").Cells(i, 1).Value

Me.ListBox1.List(ListBox1.ListCount - 1, 1) = Sheets("Sheet1").Cells(i, 2).Value

Next i

ActiveWorkbook.Close

Application.ScreenUpdating = True

End Sub

Listbox Get sum Monthly total from Worksheet Excell VBA

Combobox Fill

Private Sub UserForm_Initialize()

For i = 0 To 3

Me.ComboBox1.AddItem Format(Date, "YYYY") - i

Next i

Me.ComboBox1.Value = Format(Date, "YYYY")

End Sub

Listbox Fill

Private Sub ComboBox1_Change()

Me.ListBox1.Clear

For i = 0 To 11

A = Application.WorksheetFunction.EDate("1" & "/" & "January" & "/" & Me.ComboBox1.Value, i)

B = Application.WorksheetFunction.EoMonth("1" & "/" & "January" & "/" & Me.ComboBox1.Value, i)

Me.ListBox1.AddItem Format(A, "MMMM")

Me.ListBox1.List(ListBox1.ListCount - 1, 1) = Application.WorksheetFunction.SumIfs _

(Sheet1.Range("B:B"), Sheet1.Range("A:A"), _

">=" & A, Sheet1.Range("A:A"), "<=" & B)

Next i

End Sub

Listbox Additem From Other Listbox Excell VBA

VBA Code

Private Sub CommandButton1_Click()

For i = 0 To Me.ListBox1.ListCount - 1

If Me.ListBox1.Selected(i) = True Then

Me.ListBox2.AddItem Me.ListBox1.Column(0)

Me.ListBox1.Selected(i) = False

End If

Next i

End Sub

Multiple Listbox Additem From worksheeet Excell VBA

VBA Code

Private Sub UserForm_Initialize()

Dim i As Long

For i = 1 To Application.WorksheetFunction.CountA(Sheet1.Range("A:C"))

For x = 1 To 3

Me("listbox" & x).AddItem Sheet1.Cells(i, x).Value

Me("listbox" & x).Selected(0) = True

Next x

Next i

End Sub