Monday, September 13, 2021
Thursday, June 3, 2021
Thursday, May 27, 2021
Monday, May 24, 2021
Listbox Data Transfer To Particular Sheet Excel VBA
Listbox Data Transfer To Particular Sheet Excel VBA
Watch Video
VBA Code
Private Sub ComboBox1_Change() 'Combobox
For c = 1 To Me.ListBox1.ListCount - 1
If Format(Me.ListBox1.List(c, 0), "M") = Val(Me.ComboBox1.ListIndex) + 1 Then
Me.ListBox1.Selected(c) = True
End If
Next c
Me.CommandButton2.Enabled = True
End Sub
Private Sub CommandButton2_Click() 'Custom Transfer
Dim i As Long, MNT As Integer
Application.ScreenUpdating = False
For i = 1 To Me.ListBox1.ListCount - 1
If Me.ListBox1.Selected(i) = True Then
MNT = Format(Me.ListBox1.List(i), "M")
Sheets(MNT + 1).Range("A1000000").End(xlUp).Offset(1, 0) = Me.ListBox1.List(i, 0)
Sheets(MNT + 1).Range("A1000000").End(xlUp).Offset(0, 1) = Me.ListBox1.List(i, 1)
Sheets(MNT + 1).Range("A1000000").End(xlUp).Offset(0, 2) = Me.ListBox1.List(i, 2)
Sheets(MNT + 1).Range("A1000000").End(xlUp).Offset(0, 3) = Me.ListBox1.List(i, 3)
End If
Me.ListBox1.Selected(i) = False
Next i
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton3_Click() 'Transfer All
Dim i As Long, MNT As Integer
Application.ScreenUpdating = False
For i = 1 To Me.ListBox1.ListCount - 1
MNT = Format(Me.ListBox1.List(i), "M") + 1
With Sheets(MNT).Range("A1000000").End(xlUp)
On Error Resume Next
.Offset(1, 0) = Me.ListBox1.List(i, 0)
.Offset(1, 1) = Me.ListBox1.List(i, 1)
.Offset(1, 2) = Me.ListBox1.List(i, 2)
.Offset(1, 3) = Me.ListBox1.List(i, 3)
End With
Next i
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton4_Click() 'Unselect
Dim i As Integer
For i = 1 To Me.ListBox1.ListCount - 1
Me.ListBox1.Selected(i) = False
Next i
Me.CommandButton2.Enabled = False
End Sub
Private Sub ListBox1_Enter()
Me.CommandButton2.Enabled = True
End Sub
Private Sub UserForm_Initialize() 'Listbox Fill
Dim i As Long
For i = 1 To Sheet1.Range("A1000000").End(xlUp).Row
Me.ListBox1.AddItem
For c = 1 To 4
On Error Resume Next
Me.ListBox1.List(i - 1, c - 1) = Sheet1.Cells(i, c)
Next c
Next i
Me.ListBox1.Selected(0) = True
For x = 1 To Worksheets.Count 'Combobox Fill
Me.ComboBox1.AddItem MonthName(x)
Next x
End Sub
Private Sub CommandButton2_Click() 'Clear Worksheet
Dim i As Long, MNT As Integer
Application.ScreenUpdating = False
For MNT = 2 To Worksheets.Count
For i = 2 To Sheets(MNT).Range("A1000000").End(xlUp).Row
Sheets(MNT).Range("A" & 2, "D" & i).ClearContents
Next i
Next MNT
Application.ScreenUpdating = True
End Sub
Thursday, May 20, 2021
Monday, May 17, 2021
Thursday, May 6, 2021
Monday, April 26, 2021
Monday, February 22, 2021
Create Hide And Seek Contact form Excel VBA
Create Hide And Seek Contact form Excel VBA
VBA Code
Private Sub CMD1_Click()
On Error Resume Next
a = 24
b = 30
Me.TEL2.Left = a
Me.TEL2.Top = Me.TEL1.Top + b
Me.MOBILE1.Top = Me.MOBILE1.Top + b
Me.MOBILE2.Top = Me.MOBILE1.Top + b
Me.EMAIL1.Top = Me.EMAIL1.Top + b
Me.EMAIL2.Top = Me.EMAIL1.Top + b
Me.ADDRESS1.Top = Me.ADDRESS1.Top + b
Me.ADDRESS2.Top = Me.ADDRESS1.Top + b
Me.CMD2.Top = Me.MOBILE1.Top
Me.CMD3.Top = Me.EMAIL1.Top
Me.CMD4.Top = Me.ADDRESS1.Top
Me.CMD6.Top = Me.MOBILE1.Top
Me.CMD7.Top = Me.EMAIL1.Top
Me.CMD8.Top = Me.ADDRESS1.Top
Me.TEL2.TabStop = True
Me.CMD1.Visible = False
Me.CMD5.Visible = True
End Sub
Private Sub CMD2_Click()
On Error Resume Next
a = 24
b = 30
Me.MOBILE2.Left = a
Me.MOBILE2.Top = Me.MOBILE1.Top + 30
Me.EMAIL1.Top = Me.EMAIL1.Top + b
Me.EMAIL2.Top = Me.EMAIL1.Top + b
Me.ADDRESS1.Top = Me.ADDRESS1.Top + b
Me.ADDRESS2.Top = Me.ADDRESS1.Top + b
Me.CMD2.Top = Me.MOBILE1.Top
Me.CMD3.Top = Me.EMAIL1.Top
Me.CMD4.Top = Me.ADDRESS1.Top
Me.CMD6.Top = Me.MOBILE1.Top
Me.CMD7.Top = Me.EMAIL1.Top
Me.CMD8.Top = Me.ADDRESS1.Top
Me.MOBILE2.TabStop = True
Me.CMD2.Visible = False
Me.CMD6.Visible = True
End Sub
Private Sub CMD3_Click()
On Error Resume Next
a = 24
b = 30
Me.EMAIL2.Left = a
Me.EMAIL2.Top = Me.EMAIL1.Top + 30
Me.ADDRESS1.Top = Me.ADDRESS1.Top + b
Me.ADDRESS2.Top = Me.ADDRESS1.Top + b
Me.CMD2.Top = Me.MOBILE1.Top
Me.CMD3.Top = Me.EMAIL1.Top
Me.CMD4.Top = Me.ADDRESS1.Top
Me.CMD6.Top = Me.MOBILE1.Top
Me.CMD7.Top = Me.EMAIL1.Top
Me.CMD8.Top = Me.ADDRESS1.Top
Me.EMAIL2.TabStop = True
Me.CMD3.Visible = False
Me.CMD7.Visible = True
End Sub
Private Sub CMD4_Click()
On Error Resume Next
a = 24
b = 30
Me.ADDRESS2.Left = a
Me.ADDRESS2.Top = Me.ADDRESS1.Top + b
Me.CMD4.Top = Me.ADDRESS1.Top
Me.CMD8.Top = Me.ADDRESS1.Top
Me.ADDRESS2.TabStop = True
Me.CMD4.Visible = False
Me.CMD8.Visible = True
End Sub
Private Sub CMD5_Click()
On Error Resume Next
a = 465.75
b = 30
Me.TEL2.Left = a
Me.TEL2.Top = Me.TEL1.Top - b
Me.MOBILE1.Top = Me.MOBILE1.Top - 30
Me.MOBILE2.Top = Me.MOBILE1.Top - 30
Me.EMAIL1.Top = Me.EMAIL1.Top - b
Me.EMAIL2.Top = Me.EMAIL1.Top - b
Me.ADDRESS1.Top = Me.ADDRESS1.Top - b
Me.ADDRESS2.Top = Me.ADDRESS1.Top - b
Me.CMD2.Top = Me.MOBILE1.Top
Me.CMD3.Top = Me.EMAIL1.Top
Me.CMD4.Top = Me.ADDRESS1.Top
Me.CMD6.Top = Me.MOBILE1.Top
Me.CMD7.Top = Me.EMAIL1.Top
Me.CMD8.Top = Me.ADDRESS1.Top
Me.CMD1.Visible = True
Me.CMD5.Visible = False
End Sub
Private Sub CMD6_Click()
On Error Resume Next
a = 465.75
b = 30
Me.MOBILE2.Left = a
Me.MOBILE2.Top = Me.MOBILE1.Top - 30
Me.EMAIL1.Top = Me.EMAIL1.Top - b
Me.EMAIL2.Top = Me.EMAIL1.Top - b
Me.ADDRESS1.Top = Me.ADDRESS1.Top - b
Me.ADDRESS2.Top = Me.ADDRESS1.Top - b
Me.CMD2.Top = Me.MOBILE1.Top
Me.CMD3.Top = Me.EMAIL1.Top
Me.CMD4.Top = Me.ADDRESS1.Top
Me.CMD6.Top = Me.MOBILE1.Top
Me.CMD7.Top = Me.EMAIL1.Top
Me.CMD8.Top = Me.ADDRESS1.Top
Me.CMD2.Visible = True
Me.CMD6.Visible = False
End Sub
Private Sub CMD7_Click()
On Error Resume Next
a = 465.75
b = 30
Me.EMAIL2.Left = a
Me.EMAIL2.Top = Me.EMAIL1.Top - b
Me.ADDRESS1.Top = Me.ADDRESS1.Top - b
Me.ADDRESS2.Top = Me.ADDRESS2.Top - b
Me.CMD3.Top = Me.EMAIL1.Top
Me.CMD4.Top = Me.ADDRESS1.Top
Me.CMD8.Top = Me.ADDRESS1.Top
Me.CMD3.Visible = True
Me.CMD7.Visible = False
End Sub
Private Sub CMD8_Click()
On Error Resume Next
a = 465.75
b = 30
Me.ADDRESS2.Left = a
Me.ADDRESS2.Top = Me.ADDRESS1.Top - b
Me.CMD4.Top = Me.ADDRESS1.Top
Me.CMD8.Top = Me.ADDRESS1.Top
Me.CMD4.Visible = True
Me.CMD8.Visible = False
End Sub
Private Sub CommandButton2_Click()
Dim I As Long
I = Sheet2.Range("A1000000").End(xlUp).Row + 1
Sheet2.Range("A" & I) = Me.NMEBOX1
Sheet2.Range("B" & I) = Me.NMEBOX2
Sheet2.Range("C" & I) = Me.TELBOX1
Sheet2.Range("D" & I) = Me.TELBOX2
Sheet2.Range("E" & I) = Me.mobbox
Sheet2.Range("F" & I) = Me.mobbox2
Sheet2.Range("G" & I) = Me.EMBOX1
Sheet2.Range("H" & I) = Me.EMBOX2
Sheet2.Range("I" & I) = Me.ADDRESSBOX1
Sheet2.Range("j" & I) = Me.ADDRESSBOX2
'Fore Clear YTextbox
Dim ctr As Control
For Each ctr In UserForm1.Controls
On Error Resume Next
ctr.Value = ""
Next ctr
Me.NMEBOX1.SetFocus
End Sub
Thursday, February 18, 2021
Friday, February 5, 2021
Create Cashbook Report Userform Excel VBA
Create Cashbook Report Userform Excel VBA
VBA CODE
Private Sub ComboBox1_Change()
Me.ListBox1.Clear
Me.ListBox1.AddItem
For r = 1 To 9
Me.ListBox1.List(0, r - 1) = Sheet1.Cells(1, r)
Next r
Me.ListBox1.Selected(0) = True
Dim I As Long
For I = 2 To Sheet1.Range("A1000000").End(xlUp).Row
If Sheet1.Cells(I, "G") = CStr(Me.ComboBox1) And Sheet1.Cells(I, "A") = CDate(Me.TextBox1) Then
Me.ListBox1.AddItem
For c = 0 To 9
Me.ListBox1.List(ListBox1.ListCount - 1, c) = Sheet1.Cells(I, c + 1)
Next c
End If
Next I
Dim M As Integer
Dim SUM, SUM1 As Double
For M = 1 To Me.ListBox1.ListCount - 1
If Me.ListBox1.List(M, 6) = Me.ComboBox1 Then
SUM = SUM + Val(Me.ListBox1.List(M, 4))
SUM1 = SUM1 + Val(Me.ListBox1.List(M, 5))
End If
Next M
Me.ListBox1.AddItem Me.ComboBox1
Me.ListBox1.List(ListBox1.ListCount - 1, 3) = "Total"
Me.ListBox1.List(ListBox1.ListCount - 1, 4) = Format(SUM, "#####.00")
Me.ListBox1.List(ListBox1.ListCount - 1, 5) = Format(SUM1, "#####.00")
Me.ListBox1.AddItem "____________"
Me.ListBox1.List(ListBox1.ListCount - 1, 3) = "Balance"
Me.ListBox1.List(ListBox1.ListCount - 1, 4) = Format(SUM - SUM1, "#####.00")
SUM = 0
SUM1 = 0
End Sub
Private Sub ComboBox2_Change()
Me.ListBox1.Clear
Me.ListBox1.AddItem
For r = 1 To 9
Me.ListBox1.List(0, r - 1) = Sheet1.Cells(1, r)
Next r
Me.ListBox1.Selected(0) = True
Dim I As Long
For I = 2 To Sheet1.Range("A1000000").End(xlUp).Row
If Sheet1.Cells(I, "i") = CStr(Me.ComboBox2) And Sheet1.Cells(I, "A") = CDate(Me.TextBox1) Then
Me.ListBox1.AddItem
For c = 0 To 9
Me.ListBox1.List(ListBox1.ListCount - 1, c) = Sheet1.Cells(I, c + 1)
Next c
End If
Next I
Dim M As Integer
Dim SUM, SUM1 As Double
For M = 1 To Me.ListBox1.ListCount - 1
If Me.ListBox1.List(M, 8) = Me.ComboBox2 Then
SUM = SUM + Val(Me.ListBox1.List(M, 4))
SUM1 = SUM1 + Val(Me.ListBox1.List(M, 5))
End If
Next M
Me.ListBox1.AddItem Me.ComboBox2
Me.ListBox1.List(ListBox1.ListCount - 1, 3) = "Total"
Me.ListBox1.List(ListBox1.ListCount - 1, 4) = Format(SUM, "#####.00")
Me.ListBox1.List(ListBox1.ListCount - 1, 5) = Format(SUM1, "#####.00")
Me.ListBox1.AddItem "____________"
Me.ListBox1.List(ListBox1.ListCount - 1, 3) = "Balance"
Me.ListBox1.List(ListBox1.ListCount - 1, 4) = Format(SUM - SUM1, "#####.00")
SUM = 0
SUM1 = 0
End Sub
Private Sub CommandButton1_Click()
Me.ListBox1.Clear
Me.ListBox1.AddItem
For r = 1 To 9
Me.ListBox1.List(0, r - 1) = Sheet1.Cells(1, r)
Next r
Me.ListBox1.Selected(0) = True
Dim I As Long
Dim X As Integer
For X = 0 To Me.ComboBox1.ListCount - 1
For I = 2 To Sheet1.Range("A1000000").End(xlUp).Row
If Sheet1.Cells(I, "G") = CStr(Me.ComboBox1.List(X, 0)) And Sheet1.Cells(I, "A") = CDate(Me.TextBox1) Then
Me.ListBox1.AddItem
For c = 0 To 9
Me.ListBox1.List(ListBox1.ListCount - 1, c) = Sheet1.Cells(I, c + 1)
Next c
End If
Next I
Dim M As Integer
Dim SUM, SUM1 As Double
For M = 1 To Me.ListBox1.ListCount - 1
If Me.ListBox1.List(M, 6) = Me.ComboBox1.List(X, 0) Then
SUM = SUM + Val(Me.ListBox1.List(M, 4))
SUM1 = SUM1 + Val(Me.ListBox1.List(M, 5))
End If
Next M
Me.ListBox1.AddItem Me.ComboBox1.List(X, 0)
Me.ListBox1.List(ListBox1.ListCount - 1, 3) = "Total"
Me.ListBox1.List(ListBox1.ListCount - 1, 4) = Format(SUM, "#####.00")
Me.ListBox1.List(ListBox1.ListCount - 1, 5) = Format(SUM1, "#####.00")
Me.ListBox1.AddItem "____________"
Me.ListBox1.List(ListBox1.ListCount - 1, 3) = "Balance"
Me.ListBox1.List(ListBox1.ListCount - 1, 4) = Format(SUM - SUM1, "#####.00")
SUM = 0
SUM1 = 0
Next X
End Sub
Private Sub SpinButton1_SpinDown()
On Error Resume Next
Me.TextBox1 = CDate(Me.TextBox1) - 1
Call CommandButton1_Click
End Sub
Private Sub SpinButton1_SpinUp()
On Error Resume Next
Me.TextBox1 = CDate(Me.TextBox1) + 1
Call CommandButton1_Click
End Sub
Private Sub UserForm_Initialize()
Me.TextBox1 = Date
Dim UID As New Collection
Dim I As Long
For I = 2 To Sheet1.Range("A1000000").End(xlUp).Row
On Error Resume Next
UID.Add CStr(Sheet1.Cells(I, "G")), CStr(Sheet1.Cells(I, "G"))
Next I
For Each itm In UID
Me.ComboBox1.AddItem itm
Next itm
Me.ComboBox2.List = Array("Cash", "Bank")
End Sub
Subscribe to:
Posts (Atom)









