Tuesday, February 28, 2017
Convert Numeric Value To Words In Userform Excell VBA
Private Sub TextBox1_Change()
On Error Resume Next
If Me.TextBox1.Text <> "" Then
Me.TextBox2.Text = SpellNumber(Me.TextBox1.Text)
Else
Me.TextBox2 = ""
End If
End Sub
Monday, February 27, 2017
Play Youtube Video IN Userform EXcell VBA
Private Sub CommandButton1_Click()
Me.ShockwaveFlash1.Movie = "https://www.youtube.com/v/acIOtfweCXY&vq=hd720"
Me.ShockwaveFlash1.AllowFullScreen = True
End Sub
Saturday, February 25, 2017
Transfer Data One Sheet TO Multiple Sheets Excell VBA
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim i As Long
For i = 2 To Application.WorksheetFunction.CountA(Sheet1.Range("A:A"))
b = Application.WorksheetFunction.CountA(Sheet2.Range("A:A")) + 1
For x = 2 To 5
For c = 0 To 3
Sheets("Sheet" & x).Range("A" & b).End(xlToLeft).Offset(0, c).Value = _
Sheet1.Cells(i, c + 1).Value
Next c
Next x
Next i
Application.ScreenUpdating = True
End Sub
Thursday, February 23, 2017
Filter Database With Customer Name In Worksheet Excell VBA
Private Sub ComboBox1_Change()
Dim i As Long
Sheet1.Range("A2:F1000").ClearContents
For i = 2 To Application.WorksheetFunction.CountA(Sheet2.Range("A:A"))
c = Application.WorksheetFunction.CountA(Sheet1.Range("A:A")) + 1
For x = 1 To 6
If Sheet2.Cells(i, 1).Value = Me.ComboBox1.Value Then
Sheet1.Range("A" & c).End(xlToLeft).Offset(0, x - 1).Value = Sheet2.Cells(i, x).Value
End If
Next x
Next i
Sheet1.Range("G2").Value = Application.WorksheetFunction.Sum(Sheet1.Range("F:F"))
End Sub
Friday, February 17, 2017
Transfer Data To worksheet And Count Days Excell VBA
Combobbox Fill
Private Sub UserForm_Initialize()
Dim i As Long
For i = 2 To Application.WorksheetFunction.CountA(Sheet2.Range("A:A"))
Me.ComboBox1.AddItem Sheet2.Cells(i, 1).Value
Next i
End Sub
Textbox Format
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)
End Sub
Data Transfer To Sheet
Private Sub CommandButton1_Click()
Dim x As Long
x = Application.WorksheetFunction.CountA(Sheet1.Range("A:A")) + 1
Sheet1.Range("A" & x).Value = Me.ComboBox1.Value
Sheet1.Range("B" & x).Value = Me.TextBox1.Text
Sheet1.Range("C" & x).Value = Me.TextBox2.Text
On Error Resume Next
Sheet1.Range("D" & x).Value = Sheet1.Range("C" & x) - Sheet1.Range("B" & x) & "Days"
End Sub
Thursday, February 16, 2017
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
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
Wednesday, February 15, 2017
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
Tuesday, February 14, 2017
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
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
Monday, February 13, 2017
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
Sunday, February 12, 2017
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
Saturday, February 11, 2017
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
Friday, February 10, 2017
Combobox Additem From worksheet Dynamic Range Excell VBA
Combobox Fill Dynamic Range Private Sub UserForm_Initialize() Dim i As LongFor i = 1 To Sheet1.Range("A1000000").End(xlUp).Offset(1, 0).Row Me.ComboBox1.AddItem Sheet1.Cells(i, 1).Value Next i End Sub |
Thursday, February 9, 2017
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
Tuesday, February 7, 2017
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 |
Monday, February 6, 2017
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
Sunday, February 5, 2017
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
Saturday, February 4, 2017
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
Friday, February 3, 2017
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
Subscribe to:
Posts (Atom)