himaruasuka
New Member
- Joined
- May 26, 2022
- Messages
- 10
- Office Version
- 2013
- Platform
- Windows
- Mobile
Hi!
I have a problem about my excel file. I want to "ADD ORDER" in the list but after adding the data, the excel hangs and suddenly auto close the file. Then it will automatically open the file again without open it.
here's my code
This is my Excel File.
drive.google.com
please help me fix it. Thanks in Advance!
I have a problem about my excel file. I want to "ADD ORDER" in the list but after adding the data, the excel hangs and suddenly auto close the file. Then it will automatically open the file again without open it.
here's my code
VBA Code:
Option Explicit
Private Comb_Arrow As Boolean
Private Sub ao_cancel_Click()
Unload Me
End Sub
Private Sub ao_confirm_Click()
' For Validation
If order_prod.Value = "" Then
MsgBox "Please Select Product", vbCritical
Exit Sub
End If
If order_qty.Value = "" Then
MsgBox "Please Enter Quantity", vbCritical
Exit Sub
End If
If order_dc.Value = "" Then
MsgBox "Please Enter Discount", vbCritical
Exit Sub
End If
If order_name.Value = "" Then
MsgBox "Please Enter Customer's Name", vbCritical
Exit Sub
End If
If order_address.Value = "" Then
MsgBox "Please Enter Customer's Address", vbCritical
Exit Sub
End If
If order_contact.Value = "" Then
MsgBox "Please Enter Customer's Contact", vbCritical
Exit Sub
End If
If order_del.Value = "" Then
MsgBox "Please Enter Delivery Date", vbCritical
Exit Sub
End If
Dim ans As Integer
ans = MsgBox("Order will be added in the queue, you want to proceed?", vbQuestion + vbYesNo + vbDefaultButton2, "Order Validation")
If ans = vbYes Then
Worksheets("Order").Unprotect "himaru"
Dim sh As Worksheet
Set sh = ActiveWorkbook.Sheets("ORDER")
Dim lr As Long
Dim table2 As ListObject
Dim lr2 As ListRow
lr = Sheets("ORDER").Range("B" & Rows.Count).End(xlUp).Row
Set table2 = sh.ListObjects("Table1")
Set lr2 = table2.ListRows.Add
With lr2
.Range(1).Value = order_id.Value
.Range(2).Value = order_date.Value
.Range(3).Value = order_del.Value
.Range(4).Value = order_prod.Value
.Range(5).Value = order_qty.Value
.Range(6).Value = order_price.Value
.Range(7).Value = order_dc.Value
.Range(10).Value = order_name.Value
.Range(11).Value = order_address.Value
.Range(12).Value = order_contact.Value
If order_met1.Value Then .Range(13).Value = "CASH"
If order_met2.Value Then .Range(13).Value = "G-CASH"
End With
Me.order_id.Value = ""
Me.order_date.Value = ""
Me.order_del.Value = ""
Me.order_prod.Value = ""
Me.order_qty.Value = ""
Me.order_price.Value = ""
Me.order_dc.Value = ""
Me.order_name.Value = ""
Me.order_address.Value = ""
Me.order_contact.Value = ""
Me.order_met1.Value = False
Me.order_met2.Value = False
Unload add_order
Exit Sub
Worksheets("Order").Protect "himaru"
Else
MsgBox "Check the details carefully!"
End If
End Sub
Private Sub order_contact_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If (KeyAscii > 47 And KeyAscii < 58) Then
KeyAscii = KeyAscii
Else
KeyAscii = 0
End If
End Sub
Private Sub order_dc_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If (KeyAscii > 47 And KeyAscii < 58) Then
KeyAscii = KeyAscii
Else
KeyAscii = 0
End If
End Sub
Private Sub order_prod_Change()
Dim i As Long
If Not Comb_Arrow Then
With Me.order_prod
.List = Worksheets("product").Range("c8", Worksheets("product") _
.Cells(Rows.Count, "c").End(xlUp)).Value
.ListRows = Application.WorksheetFunction.Min(10, .ListCount)
.DropDown
If Len(.Text) Then
For i = .ListCount - 1 To 0 Step -1
If InStr(1, .List(i), .Text, vbTextCompare) = 0 Then .RemoveItem i
Next
.DropDown
End If
End With
End If
End Sub
Private Sub order_prod_Click()
Dim price As Variant
On Error Resume Next
price = Application.Index(Range("pl_price"), _
Application.Match(order_prod.Value, Range( _
"pl_productname"), 0), 1)
order_price.Value = price
End Sub
Private Sub order_prod_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Comb_Arrow = (KeyCode = vbKeyUp) Or (KeyCode = vbKeyDown)
If KeyCode = vbKeyReturn Then Me.order_prod.List = Worksheets("product").Range("c8", Worksheets("Product").Cells(Rows.Count, "C").End(xlUp)).Value
End Sub
Private Sub order_qty_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If (KeyAscii > 47 And KeyAscii < 58) Then
KeyAscii = KeyAscii
Else
KeyAscii = 0
End If
End Sub
Private Sub order_dc_Change()
If order_qty.Value = 0 Then order_qty.Value = 0
If order_qty.Value = "" Then order_qty.Value = 0
If order_dc.Value = 0 Then order_dc.Value = 0
If order_dc.Value = "" Then order_dc.Value = 0
order_total.Value = (Val(order_qty.Value) * Val(order_price.Value)) - Val(order_dc.Value)
End Sub
Private Sub order_qty_Change()
If order_qty.Value = 0 Then order_qty.Value = 0
If order_qty.Value = "" Then order_qty.Value = 0
If order_dc.Value = 0 Then order_dc.Value = 0
If order_dc.Value = "" Then order_dc.Value = 0
order_total.Value = (Val(order_qty.Value) * Val(order_price.Value)) - Val(order_dc.Value)
'If Len(order_qty) = 0 Then order_total.Value = 0
'order_total.Value = (Val(order_qty.Value) * Val(order_price.Value)) - Val(order_dc.Value)
End Sub
Private Sub UserForm_Initialize()
order_id.Value = "HP-" & Format(Sheet2.Cells(Rows.Count, "B").End(xlUp).Row - 7, "0000")
Dim dt As Date
dt = Now()
order_date.Value = Format(dt, "MM/dD/YYYY HH:MM")
End SubThis is my Excel File.
Point of Sale v2.0.xlsm
drive.google.com
please help me fix it. Thanks in Advance!
