Banner

Monday, January 25, 2021

Sales Invoice Video#5 Save To Database And Invoice Project Excel VBA

 Sales Invoice Video#5 Save To Database And Invoice Project Excel VBA

Sales Invoice Video#5 Save To Database And Invoice Project Excel VBA


Watch Video


VBA Code


Private Sub BNKBOX_Change() On Error Resume Next Me.PAIDBOX = Format(Val(Me.CASHBOX) + Val(Me.BNKBOX), "#####.00") If Val(Me.BNKBOX) >= 1 Then Me.CRDBOX.Enabled = True Else Me.CRDBOX.Enabled = False End If End Sub Private Sub CASHBOX_Change() On Error Resume Next Me.PAIDBOX = Format(Val(Me.CASHBOX) + Val(Me.BNKBOX), "#####.00") End Sub Private Sub CommandButton1_Click() Dim i As Long For X = 1 To 6 'Textbox Clear Me("ITEMCODE" & X) = "" Me("ITEMNAME" & X) = "" Me("QTYBOX" & X).Value = "" Me("TAXAMT" & X).Value = "" Me("RATEBOX" & X).Value = "" Me("GROSSBOX" & X).Value = "" Me("TAXBOX" & X) = "" Me("TOTALBOX" & X).Value = "" On Error Resume Next Me("FRM" & X + 1).Visible = False 'frame Hide Next X Me.DTPicker1 = Date Me.NMEBOX = "" 'Textbox Clear Me.CONTBOX = "" Me.CASHBOX = "" Me.BNKBOX = "" Me.CRDBOX = "" Me.PAIDBOX = "" Me.NRBOX = "" Me.BLBCBOX = "" Me.TOTALBOX = "" With Sheet2.Range("A1000000").End(xlUp) For i = 3 To .Row If Sheet2.Cells(i, "E") = Val(Me.INVBOX) Then CNT = CNT + 1 On Error Resume Next Me("ITEMCODE" & CNT) = Sheet2.Cells(i, "H") Me("ITEMNAME" & CNT) = Sheet2.Cells(i, "i") Me("QTYBOX" & CNT).Value = Sheet2.Cells(i, "j") Me("RATEBOX" & CNT).Value = Sheet2.Cells(i, "K") Me("GROSSBOX" & CNT).Value = Sheet2.Cells(i, "L") Me("TAXBOX" & CNT) = Sheet1.Cells(2, "M") Me("TAXAMT" & CNT).Value = Sheet2.Cells(i, "N") Me("TOTALBOX" & CNT).Value = Sheet2.Cells(i, "O") Me.DTPicker1 = Sheet2.Cells(i, "B") Me.NMEBOX = Sheet2.Cells(i, "F") Me.CONTBOX = Sheet2.Cells(i, "G") Me.CASHBOX = Sheet2.Cells(i, "Q") Me.BNKBOX = Sheet2.Cells(i, "S") Me.CRDBOX = Sheet2.Cells(i, "U") Me.PAIDBOX = Sheet2.Cells(i, "V") Me.NRBOX = Sheet2.Cells(i, "X") End If Next i End With End Sub Private Sub Frame2_Click() End Sub Private Sub GROSSBOX1_Change() If Val(Me.GROSSBOX1) >= 1 Then Me.FRM2.Visible = True End If On Error Resume Next Me.TAXAMT1 = Format(Val(Me.GROSSBOX1) / 100 * Val(Me.TAXBOX1), "#####.00") Me.TOTALBOX1 = Format(Val(Me.GROSSBOX1) + Val(Me.TAXAMT1), "#####.00") End Sub Private Sub GROSSBOX2_Change() If Val(Me.GROSSBOX2) >= 1 Then Me.FRM3.Visible = True End If Me.TAXAMT2 = Format(Val(Me.GROSSBOX2) / 100 * Val(Me.TAXBOX2), "#####.00") Me.TOTALBOX2 = Format(Val(Me.GROSSBOX2) + Val(Me.TAXAMT2), "#####.00") End Sub Private Sub GROSSBOX3_Change() If Val(Me.GROSSBOX3) >= 1 Then Me.FRM4.Visible = True End If Me.TAXAMT3 = Format(Val(Me.GROSSBOX3) / 100 * Val(Me.TAXBOX3), "#####.00") Me.TOTALBOX3 = Format(Val(Me.GROSSBOX3) + Val(Me.TAXAMT3), "#####.00") End Sub Private Sub GROSSBOX4_Change() If Val(Me.GROSSBOX4) >= 1 Then Me.FRM5.Visible = True End If Me.TAXAMT4 = Format(Val(Me.GROSSBOX4) / 100 * Val(Me.TAXBOX4), "#####.00") Me.TOTALBOX4 = Format(Val(Me.GROSSBOX4) + Val(Me.TAXAMT4), "#####.00") End Sub Private Sub GROSSBOX5_Change() If Val(Me.GROSSBOX5) >= 1 Then Me.FRM6.Visible = True End If Me.TAXAMT5 = Format(Val(Me.GROSSBOX5) / 100 * Val(Me.TAXBOX5), "#####.00") Me.TOTALBOX5 = Format(Val(Me.GROSSBOX5) + Val(Me.TAXAMT5), "#####.00") End Sub Private Sub GROSSBOX6_Change() Me.TAXAMT6 = Format(Val(Me.GROSSBOX6) / 100 * Val(Me.TAXBOX6), "#####.00") Me.TOTALBOX6 = Format(Val(Me.GROSSBOX6) + Val(Me.TAXAMT6), "#####.00") End Sub Private Sub ITEMCODE1_AfterUpdate() Dim Mrow As Long On Error Resume Next Mrow = Application.WorksheetFunction.Match(Val(Me.ITEMCODE1), Sheet3.Range("B:B"), 0) Me.ITEMNAME1 = Sheet3.Range("C" & Mrow) Me.RATEBOX1 = Sheet3.Range("F" & Mrow) Me.TAXBOX1 = Sheet3.Range("G" & Mrow) End Sub Private Sub ITEMCODE1_Change() End Sub Private Sub ITEMCODE2_AfterUpdate() Dim Mrow As Long On Error Resume Next Mrow = Application.WorksheetFunction.Match(Val(Me.ITEMCODE2), Sheet3.Range("B:B"), 0) Me.ITEMNAME2 = Sheet3.Range("C" & Mrow) Me.RATEBOX2 = Sheet3.Range("F" & Mrow) Me.TAXBOX2 = Sheet3.Range("G" & Mrow) End Sub Private Sub ITEMCODE2_Change() End Sub Private Sub ITEMCODE3_AfterUpdate() Dim Mrow As Long On Error Resume Next Mrow = Application.WorksheetFunction.Match(Val(Me.ITEMCODE3), Sheet3.Range("B:B"), 0) Me.ITEMNAME3 = Sheet3.Range("C" & Mrow) Me.RATEBOX3 = Sheet3.Range("F" & Mrow) Me.TAXBOX3 = Sheet3.Range("G" & Mrow) End Sub Private Sub ITEMCODE3_Change() End Sub Private Sub ITEMCODE4_AfterUpdate() Dim Mrow As Long On Error Resume Next Mrow = Application.WorksheetFunction.Match(Val(Me.ITEMCODE4), Sheet3.Range("B:B"), 0) Me.ITEMNAME4 = Sheet3.Range("C" & Mrow) Me.RATEBOX4 = Sheet3.Range("F" & Mrow) Me.TAXBOX4 = Sheet3.Range("G" & Mrow) End Sub Private Sub ITEMCODE4_Change() End Sub Private Sub ITEMCODE5_AfterUpdate() Dim Mrow As Long On Error Resume Next Mrow = Application.WorksheetFunction.Match(Val(Me.ITEMCODE5), Sheet3.Range("B:B"), 0) Me.ITEMNAME5 = Sheet3.Range("C" & Mrow) Me.RATEBOX5 = Sheet3.Range("F" & Mrow) Me.TAXBOX5 = Sheet3.Range("G" & Mrow) End Sub Private Sub ITEMCODE6_AfterUpdate() Dim Mrow As Long On Error Resume Next Mrow = Application.WorksheetFunction.Match(Val(Me.ITEMCODE6), Sheet3.Range("B:B"), 0) Me.ITEMNAME6 = Sheet3.Range("C" & Mrow) Me.RATEBOX6 = Sheet3.Range("F" & Mrow) Me.TAXBOX6 = Sheet3.Range("G" & Mrow) End Sub Private Sub NMEBOX_Change() On Error Resume Next Me.NMEBOX = StrConv(Me.NMEBOX, vbProperCase) End Sub Private Sub NRBOX_Change() On Error Resume Next Me.NRBOX = StrConv(Me.NRBOX, vbProperCase) End Sub Private Sub PAIDBOX_Change() On Error Resume Next Me.BLBCBOX = Format(Val(Me.TOTALBOX) - Val(Me.PAIDBOX), "#####.00") End Sub Private Sub PRINTCMD_Click() If MsgBox("You want print invoice?", vbYesNo) = vbYes Then Sheet4.Range("A6:L15").ClearContents Sheet4.Range("L16:L19").ClearContents Sheet4.Range("K2") = CDate(Me.DTPicker1) Sheet4.Range("K3") = Me.INVBOX.Value Sheet4.Range("C4") = CStr(Me.NMEBOX) Sheet4.Range("G4") = Me.CONTBOX For i = 1 To 6 If Me("ITEMNAME" & i) <> "" Then With Sheet4.Range("A15").End(xlUp) .Offset(1, 0) = i .Offset(1, 1) = Me("ITEMNAME" & i) .Offset(1, 8) = Me("QTYBOX" & i).Value .Offset(1, 9) = Me("RATEBOX" & i).Value .Offset(1, 10) = Me("TOTALBOX" & i).Value End With Sheet4.Range("L16") = Me.TOTALBOX.Value Sheet4.Range("L17") = Me.VATBOX.Value Sheet4.Range("L18") = Me.PAIDBOX.Value Sheet4.Range("L19") = Me.BLBCBOX.Value Sheet4.Range("J21") = Me.Adminbox End If Next i With Sheet4.PageSetup .PrintArea = "A1:L22" .PaperSize = xlPaperA5 .Orientation = xlLandscape End With Sheet4.PrintOut End If End Sub Private Sub QTYBOX1_Change() On Error Resume Next Me.GROSSBOX1 = Format(Val(Me.QTYBOX1) * Val(Me.RATEBOX1), "#####.00") End Sub Private Sub QTYBOX2_Change() On Error Resume Next Me.GROSSBOX2 = Format(Val(Me.QTYBOX2) * Val(Me.RATEBOX2), "#####.00") End Sub Private Sub QTYBOX3_Change() On Error Resume Next Me.GROSSBOX3 = Format(Val(Me.QTYBOX3) * Val(Me.RATEBOX3), "#####.00") End Sub Private Sub QTYBOX4_Change() On Error Resume Next Me.GROSSBOX4 = Format(Val(Me.QTYBOX4) * Val(Me.RATEBOX4), "#####.00") End Sub Private Sub QTYBOX5_Change() On Error Resume Next Me.GROSSBOX5 = Format(Val(Me.QTYBOX5) * Val(Me.RATEBOX5), "#####.00") End Sub Private Sub QTYBOX6_Change() On Error Resume Next Me.GROSSBOX6 = Format(Val(Me.QTYBOX6) * Val(Me.RATEBOX6), "#####.00") End Sub Private Sub RATEBOX1_Change() On Error Resume Next Me.GROSSBOX1 = Format(Val(Me.QTYBOX1) * Val(Me.RATEBOX1), "#####.00") End Sub Private Sub RATEBOX2_Change() On Error Resume Next Me.GROSSBOX2 = Format(Val(Me.QTYBOX2) * Val(Me.RATEBOX2), "#####.00") End Sub Private Sub RATEBOX3_Change() On Error Resume Next Me.GROSSBOX3 = Format(Val(Me.QTYBOX3) * Val(Me.RATEBOX3), "#####.00") End Sub Private Sub RATEBOX4_Change() On Error Resume Next Me.GROSSBOX4 = Format(Val(Me.QTYBOX4) * Val(Me.RATEBOX4), "#####.00") End Sub Private Sub RATEBOX5_Change() On Error Resume Next Me.GROSSBOX5 = Format(Val(Me.QTYBOX5) * Val(Me.RATEBOX5), "#####.00") End Sub Private Sub RATEBOX6_Change() On Error Resume Next Me.GROSSBOX6 = Format(Val(Me.QTYBOX6) * Val(Me.RATEBOX6), "#####.00") End Sub Private Sub REFRESHCMD_Click() 'Userform clear Dim CTR As Control For Each CTR In SALESFORM.Controls On Error Resume Next CTR.Value = "" Next CTR A = Application.WorksheetFunction.CountIfs(Sheets("Database").Range("D:D"), "Sales", _ Sheets("Database").Range("P:P"), ">=" & 1) Me.INVBOX = A + 1000 For i = 2 To 6 Me("FRM" & i).Visible = False Next i End Sub Private Sub SaveCMD_Click() Dim CNT As Integer Dim X As Integer For X = 1 To 6 With Sheet2.Range("A1000000").End(xlUp) If Val(Me("ITEMCODE" & X)) >= 1 Then 'To Database(SHEET2) .Offset(1, 0) = .Row + 100 .Offset(1, 1) = CDate(Me.DTPicker1) .Offset(1, 2) = Format(Time, "HH:MM AM/PM") .Offset(1, 3) = "Sales" .Offset(1, 4) = Me.INVBOX.Value .Offset(1, 5) = Me.NMEBOX .Offset(1, 6) = Me.CONTBOX CNT = CNT + 1 .Offset(1, 7) = Me("ITEMCODE" & CNT) .Offset(1, 8) = Me("ITEMNAME" & CNT) .Offset(1, 9) = Me("QTYBOX" & CNT).Value .Offset(1, 10) = Me("RATEBOX" & CNT).Value .Offset(1, 11) = Me("GROSSBOX" & CNT).Value .Offset(1, 12) = Me("TAXBOX" & CNT) .Offset(1, 13) = Me("TAXAMT" & CNT).Value .Offset(1, 14) = Me("TOTALBOX" & CNT).Value End If End With Next X 'To Database(SHEET2) With Sheet2.Range("A1000000").End(xlUp) .Offset(1, 0) = .Row + 100 .Offset(1, 1) = CDate(Me.DTPicker1) .Offset(1, 2) = Format(Time, "HH:MM AM/PM") .Offset(1, 3) = "Sales" .Offset(1, 4) = Me.INVBOX.Value .Offset(1, 5) = Me.NMEBOX .Offset(1, 6) = Me.CONTBOX .Offset(1, 15) = Me.TOTALBOX.Value .Offset(1, 16) = Me.CASHBOX.Value .Offset(1, 18) = Me.BNKBOX.Value .Offset(1, 20) = Me.CRDBOX .Offset(1, 21) = Me.PAIDBOX.Value .Offset(1, 22) = Me.BLBCBOX.Value .Offset(1, 23) = Me.NRBOX.Value .Offset(1, 24) = Me.Adminbox End With Call PRINTCMD_Click Call REFRESHCMD_Click End Sub Private Sub SpinButton1_SpinDown() On Error Resume Next Me.INVBOX = Val(Me.INVBOX) - 1 Call CommandButton1_Click End Sub Private Sub SpinButton1_SpinUp() On Error Resume Next Me.INVBOX = Val(Me.INVBOX) + 1 Call CommandButton1_Click End Sub Private Sub TAXBOX1_Change() On Error Resume Next Me.TAXAMT1 = Format(Val(Me.GROSSBOX1) / 100 * Val(Me.TAXBOX1), "#####.00") Me.TOTALBOX1 = Format(Val(Me.GROSSBOX1) + Val(Me.TAXAMT1), "#####.00") End Sub Private Sub TAXBOX2_Change() On Error Resume Next Me.TAXAMT2 = Format(Val(Me.GROSSBOX2) / 100 * Val(Me.TAXBOX2), "#####.00") Me.TOTALBOX2 = Format(Val(Me.GROSSBOX2) + Val(Me.TAXAMT2), "#####.00") End Sub Private Sub TAXBOX3_Change() On Error Resume Next Me.TAXAMT3 = Format(Val(Me.GROSSBOX3) / 100 * Val(Me.TAXBOX3), "#####.00") Me.TOTALBOX3 = Format(Val(Me.GROSSBOX3) + Val(Me.TAXAMT3), "#####.00") End Sub Private Sub TAXBOX4_Change() On Error Resume Next Me.TAXAMT4 = Format(Val(Me.GROSSBOX4) / 100 * Val(Me.TAXBOX4), "#####.00") Me.TOTALBOX4 = Format(Val(Me.GROSSBOX4) + Val(Me.TAXAMT4), "#####.00") End Sub Private Sub TAXBOX5_Change() On Error Resume Next Me.TAXAMT5 = Format(Val(Me.GROSSBOX5) / 100 * Val(Me.TAXBOX5), "#####.00") Me.TOTALBOX5 = Format(Val(Me.GROSSBOX5) + Val(Me.TAXAMT5), "#####.00") End Sub Private Sub TAXBOX6_Change() On Error Resume Next Me.TAXAMT6 = Format(Val(Me.GROSSBOX6) / 100 * Val(Me.TAXBOX6), "#####.00") Me.TOTALBOX6 = Format(Val(Me.GROSSBOX6) + Val(Me.TAXAMT6), "#####.00") End Sub Private Sub TOTALBOX_Change() On Error Resume Next Me.BLBCBOX = Format(Val(Me.TOTALBOX) - Val(Me.PAIDBOX), "#####.00") End Sub Private Sub TOTALBOX1_Change() Dim X As Integer Dim SUM, SUM1 As Double For X = 1 To 6 SUM = SUM + Val(Me("TOTALBOX" & X)) SUM1 = SUM1 + Val(Me("TAXAMT" & X)) Next X Me.TOTALBOX = Format(SUM, "#####.00") Me.VATBOX = Format(SUM1, "#####.00") End Sub Private Sub TOTALBOX2_Change() Dim X As Integer Dim SUM, SUM1 As Double For X = 1 To 6 SUM = SUM + Val(Me("TOTALBOX" & X)) SUM1 = SUM1 + Val(Me("TAXAMT" & X)) Next X Me.TOTALBOX = Format(SUM, "#####.00") Me.VATBOX = Format(SUM1, "#####.00") End Sub Private Sub TOTALBOX3_Change() Dim X As Integer Dim SUM, SUM1 As Double For X = 1 To 6 SUM = SUM + Val(Me("TOTALBOX" & X)) SUM1 = SUM1 + Val(Me("TAXAMT" & X)) Next X Me.TOTALBOX = Format(SUM, "#####.00") Me.VATBOX = Format(SUM1, "#####.00") End Sub Private Sub TOTALBOX4_Change() Dim X As Integer Dim SUM, SUM1 As Double For X = 1 To 6 SUM = SUM + Val(Me("TOTALBOX" & X)) SUM1 = SUM1 + Val(Me("TAXAMT" & X)) Next X Me.TOTALBOX = Format(SUM, "#####.00") Me.VATBOX = Format(SUM1, "#####.00") End Sub Private Sub TOTALBOX5_Change() Dim X As Integer Dim SUM, SUM1 As Double For X = 1 To 6 SUM = SUM + Val(Me("TOTALBOX" & X)) SUM1 = SUM1 + Val(Me("TAXAMT" & X)) Next X Me.TOTALBOX = Format(SUM, "#####.00") Me.VATBOX = Format(SUM1, "#####.00") End Sub Private Sub TOTALBOX6_Change() Dim X As Integer Dim SUM, SUM1 As Double For X = 1 To 6 SUM = SUM + Val(Me("TOTALBOX" & X)) SUM1 = SUM1 + Val(Me("TAXAMT" & X)) Next X Me.TOTALBOX = Format(SUM, "#####.00") Me.VATBOX = Format(SUM1, "#####.00") End Sub Private Sub UserForm_Activate() Dim A As Long On Error Resume Next A = Application.WorksheetFunction.CountIfs(Sheets("Database").Range("D:D"), _ Sales, Sheets("Database").Range("P:P"), ">=" & 1) Me.INVBOX = A + 1000 Me.Adminbox.AddItem "Cashier 1" Me.Adminbox.AddItem "Cashier 2" Me.Adminbox.AddItem "Cashier 3" Me.Adminbox.AddItem "Cashier 4" Me.Adminbox = "Cashier 1" End Sub Private Sub UserForm_Initialize() Dim FWidth As Long FWidth = Application.Width Me.Width = FWidth - 20 Me.Frame1.Width = Me.Width - 20 Me.Frame2.Width = Me.Width - 20 Me.Label1.Width = Me.Frame1.Width Me.DTPicker1 = Date Lwidth = Me.Frame1.Width Me.FRM1.Width = Lwidth Me.FRM2.Width = Lwidth Me.FRM3.Width = Lwidth Me.FRM4.Width = Lwidth Me.FRM5.Width = Lwidth Me.FRM6.Width = Lwidth Me.Label3.Width = Me.Frame1.Width Me.FRM1.SetFocus End Sub




Thursday, November 5, 2020

Listbox advance Filter Userform Excel VBA

 Listbox advance Filter Userform Excel VBA


Listbox advance Filter Userform Excel VBA

Watch Video


VBA Code

Listbox Fill

Private Sub UserForm_Initialize()
Dim i As Long
Dim X As Integer
For i = 1 To Sheet1.Range("A1000000").End(xlUp).Row
Me.ListBox1.AddItem
For X = 1 To 7
Me.ListBox1.List(i - 1, X - 1) = Sheet1.Cells(i, X)
Next X
Next i
End Sub

Combobox Fill Without Duplicate Value

Private Sub UserForm_Activate()
'Voucher Box Fill
Dim i As Long  'Cobobox fill   Voucher
Dim VCH As New Collection
Dim Mylist As String
For i = 2 To Sheet1.Range("A1000000").End(xlUp).Row
On Error Resume Next
VCH.Add Sheet1.Cells(i, "A"), Sheet1.Cells(i, "A")
Next i
For Each ITM In VCH
Me.VCHBox.AddItem ITM
Next ITM

'Name Box Fill
Dim X As Long
Dim NME As New Collection     'Cobobox fill   Namebox
For X = 2 To Sheet1.Range("A1000000").End(xlUp).Row
NME.Add Sheet1.Cells(X, "B"), Sheet1.Cells(X, "B")
Next X
For Each NIT In NME
Me.NAMEBox.AddItem NIT
Next NIT

'Admin Box Fill
Dim c As Long
Dim ADM As New Collection      'Cobobox fill Admin
For c = 2 To Sheet1.Range("A1000000").End(xlUp).Row
ADM.Add Sheet1.Cells(c, "C"), Sheet1.Cells(c, "C")
Next c

For Each MIT In ADM
Me.ADMNBox.AddItem MIT
Next MIT

End Sub


'Combobox  Activate

Private Sub VCHBox_Change()
Dim i, X As Integer
Dim Mylist As String
With Me.ListBox1
For i = 1 To .ListCount - 1
For X = i To .ListCount - 1
If .List(X, 0) = Me.VCHBox Then
For c = 0 To 6
Mylist = .List(X, c)
.List(X, c) = .List(i, c)
.List(i, c) = Mylist
Me.ListBox1.Selected(i) = True
Next c
End If
Next X
Next i

Dim M As Integer
Dim SUM, SUM1 As Double
For M = 1 To .ListIndex()
SUM = SUM + Val(.List(M, 3))
SUM1 = SUM1 + Val(.List(M, 4))
Next M
Me.TextBox1 = Format(SUM1, "#####.00")
Me.TextBox2 = Format(SUM, "#####.00")

End With
End Sub

Private Sub NAMEBox_Change()
Dim i, X As Integer
Dim Mylist As String
With Me.ListBox1
For i = 1 To .ListCount - 1
For X = i To .ListCount - 1
If .List(X, 1) = Me.NAMEBox Then
For c = 0 To 6
Mylist = .List(X, c)
.List(X, c) = .List(i, c)
.List(i, c) = Mylist
Me.ListBox1.Selected(i) = True
Next c
End If
Next X
Next i

Dim M As Integer
Dim SUM, SUM1 As Double
For M = 1 To .ListIndex()
SUM = SUM + Val(.List(M, 3))
SUM1 = SUM1 + Val(.List(M, 4))
Next M
Me.TextBox1 = Format(SUM1, "#####.00")
Me.TextBox2 = Format(SUM, "#####.00")

End With
End Sub


Private Sub ADMNBox_Change()
Dim i, X As Integer
Dim Mylist As String
With Me.ListBox1
For i = 1 To .ListCount - 1
For X = i To .ListCount - 1
If .List(X, 2) = Me.ADMNBox Then
For c = 0 To 6
Mylist = .List(X, c)
.List(X, c) = .List(i, c)
.List(i, c) = Mylist
Me.ListBox1.Selected(i) = True
Next c
End If
Next X
Next i

Dim M As Integer
Dim SUM, SUM1 As Double
For M = 1 To .ListIndex()
SUM = SUM + Val(.List(M, 3))
SUM1 = SUM1 + Val(.List(M, 4))
Next M
Me.TextBox1 = Format(SUM1, "#####.00")
Me.TextBox2 = Format(SUM, "#####.00")

End With
End Sub


 

 

Thursday, September 24, 2020

TreeView Conditional Format Useform Excel VBA

 TreeView Conditional Format Useform Excel VBA

Create Mini Calendar


Watch Video

VBA code
Private Sub UserForm_Initialize()
Dim i, x As Integer
With Me.TreeView1
'Title
.Nodes.Add , , "A1", "Calendar  " & Year(Date)
'Month Name
For i = 1 To 12
.Nodes.Add , , "B" & i, MonthName(i)

'Calendar
For C = 1 To 31
On Error Resume Next
.Nodes.Add "B" & 1, tvwChild, "C" & C, CDate(C & "/" & 1 & "/" & Year(Date))
.Nodes.Add "B" & 2, tvwChild, "D" & C, CDate(C & "/" & 2 & "/" & Year(Date))
.Nodes.Add "B" & 3, tvwChild, "E" & C, CDate(C & "/" & 3 & "/" & Year(Date))
.Nodes.Add "B" & 4, tvwChild, "F" & C, CDate(C & "/" & 4 & "/" & Year(Date))
.Nodes.Add "B" & 5, tvwChild, "G" & C, CDate(C & "/" & 5 & "/" & Year(Date))
.Nodes.Add "B" & 6, tvwChild, "H" & C, CDate(C & "/" & 6 & "/" & Year(Date))
.Nodes.Add "B" & 7, tvwChild, "I" & C, CDate(C & "/" & 7 & "/" & Year(Date))
.Nodes.Add "B" & 8, tvwChild, "J" & C, CDate(C & "/" & 8 & "/" & Year(Date))
.Nodes.Add "B" & 9, tvwChild, "K" & C, CDate(C & "/" & 9 & "/" & Year(Date))
.Nodes.Add "B" & 10, tvwChild, "L" & C, CDate(C & "/" & 10 & "/" & Year(Date))
.Nodes.Add "B" & 11, tvwChild, "M" & C, CDate(C & "/" & 11 & "/" & Year(Date))
.Nodes.Add "B" & 12, tvwChild, "N" & C, CDate(C & "/" & 12 & "/" & Year(Date))
Next C
Next i
'Days
For x = 2 To .Nodes.Count
.Nodes.Add .Nodes(x).Key, tvwChild, "O" & x, Format(.Nodes(x).Text, "DDDD")

'Conditional format
If .Nodes(x).Text = Format(Date, "MMMM") Then
.Nodes(x).ForeColor = &H8000&
End If
If Format(.Nodes(x).Text, "DDDD") = "Sunday" Then
.Nodes(x).ForeColor = vbRed
.Nodes(x).Child.ForeColor = vbRed
End If
Next x
End With
End Sub