Banner

Thursday, July 27, 2017

Advance Filter#2 Select Criteria In any Column ExcellVBA



Private Sub OptionButton1_Click()
Me.ComboBox1 = ""
Me.ComboBox1.BoundColumn = 1
Sheet1.Range("H3:J3") = ""
End Sub
Private Sub OptionButton2_Click()
Me.ComboBox1 = ""
Me.ComboBox1.BoundColumn = 2
Sheet1.Range("H3:J3") = ""
End Sub
Private Sub OptionButton3_Click()
Me.ComboBox1 = ""
Me.ComboBox1.BoundColumn = 3
Sheet1.Range("H3:J3") = ""
End Sub

Private Sub ComboBox1_Click()
Dim i As Long
If Me.OptionButton1.Value = True Then
Sheet1.Range("H3").Value = Me.ComboBox1.Value
ElseIf Me.OptionButton2.Value = True Then
Sheet1.Range("I3").Value = Me.ComboBox1.Value
Else
Sheet1.Range("J3").Value = Me.ComboBox1.Value
End If
On Error Resume Next
ActiveSheet.ShowAllData
i = Sheet1.Range("A100000").End(xlUp).Offset(1, 0).Row
Sheet1.Range("A" & 2, "G" & i).AdvancedFilter xlFilterInPlace, Sheet1.Range("H2:J3")
End Sub

Thursday, July 20, 2017

Listbox FilterTo Other Listbox Userform Exel VBA



Private Sub UserForm_Initialize()
Me.ListBox1.RowSource = "Data"
End Sub

Private Sub TextBox1_Change()
Me.ListBox2.Clear
For i = 0 To Me.ListBox1.ListCount - 1
a = Len(Me.TextBox1.Text)
Me.ListBox1.Selected(i) = False
If Me.TextBox1 <> "" Then
If LCase(Left(Me.ListBox1.List(i, 0), a)) = Me.TextBox1.Text Or _
UCase(Left(Me.ListBox1.List(i, 0), a)) = Me.TextBox1.Text Then
Me.ListBox1.Selected(i) = True
Me.ListBox2.AddItem Me.ListBox1.List(i, 0)
End If
End If
Next i
End Sub


Thursday, July 13, 2017

Textbox Avoid Duplicate Entry Userform Excel VBA



Private Sub TextBox1_AfterUpdate()
Dim a As Long
a = Application.WorksheetFunction.CountIf(Sheet1.Range("A:A"), _
Me.TextBox1.Text)
If a >= 1 Then
Me.TextBox1 = ""
MsgBox "PLease This Name Already submited"
End If
End Sub

Private Sub CommandButton1_Click()
Dim a As Long, x As Long
a = Application.WorksheetFunction.CountIf(Sheet1.Range("A:A"), Me.TextBox1.Text)
x = Application.WorksheetFunction.CountA(Sheet1.Range("A:A")) + 1
If Me.TextBox1 <> "" And Me.TextBox2 <> "" And a = 0 Then
Sheet1.Range("a" & x).Value = Me.TextBox1.Text
Sheet1.Range("B" & x).Value = Me.TextBox2.Text
Else
MsgBox "PLease This Name Already submited Or Textbox Blank"
End If
End Sub

Friday, July 7, 2017

Create Pdf PlayLlst In Userform And Open Pdf File Excel VBA



Private Sub UserForm_Initialize()
Dim i As Long
Me.ListBox1.Clear
Me.ListBox1.AddItem "File Numbers"
Me.ListBox1.Selected(0) = True
For i = 2 To Sheet1.Range("A10000").End(xlUp).Offset(1, 0).Row - 1
Me.ListBox1.AddItem "File Number" & i + 9999
Me.ListBox1.List(ListBox1.ListCount - 1, 1) = Sheet1.Cells(i, 1).Value
Next i
End Sub

Private Sub CommandButton1_Click()
Dim MyFolder As String, i As Long
MyFolder = Application.GetSaveAsFilename()
Sheet1.Range("A10000").End(xlUp).Offset(1, 0).Value = MyFolder
Me.ListBox1.Clear
Me.ListBox1.AddItem "File Numbers"
Me.ListBox1.Selected(0) = True
For i = 2 To Sheet1.Range("A10000").End(xlUp).Offset(1, 0).Row - 1
Me.ListBox1.AddItem "File Number" & i + 9999
Me.ListBox1.List(ListBox1.ListCount - 1, 1) = Sheet1.Cells(i, 1).Value
Next i
End Sub

Private Sub ListBox1_Click()
On Error Resume Next
Me.AcroPDF1.LoadFile Me.ListBox1.Column(1)
End Sub