Untitled

mail@pastecode.io avatar
unknown
plain_text
a year ago
11 kB
0
Indexable
Never
Option Explicit

Private IsArrow As Boolean

Private Sub CMBBXCUSTOMER_Change()

    Dim i As Long
    
    If Not IsArrow Then
        With Me.CMBBXCUSTOMER
            .List = Worksheets("CustomerData").Range("A4", Worksheets("CustomerData").Cells(Rows.count, "A").End(xlUp)).Value
            .ListRows = Application.WorksheetFunction.Min(6, .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 CMBBXCUSTOMER_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    IsArrow = (KeyCode = vbKeyUp) Or (KeyCode = vbKeyDown)
    If KeyCode = vbKeyReturn Then Me.CMBBXCUSTOMER.List = Worksheets("CustomerData").Range("A4", Worksheets("CustomerData").Cells(Rows.count, "A").End(xlUp)).Value
End Sub

Private Sub CMBBXCUSTOMER_DropButtonClick()
    With Me.CMBBXCUSTOMER
        .List = Worksheets("CustomerData").Range("A4", Worksheets("CustomerData").Cells(Rows.count, "A").End(xlUp)).Value
        .ListRows = Application.WorksheetFunction.Min(6, .ListCount)
        .DropDown
    End With
End Sub

Private Sub UserForm_Initialize()
    DTPicker1.Value = vbNull
    FormatDTPicker
End Sub

Private Sub DTPicker1_CloseUp()
  FormatDTPicker
End Sub

Private Sub DTPicker1_Format(ByVal CallbackField As String, FormattedString As String)
  If CallbackField = "X" Then FormattedString = ""
End Sub

Private Sub DTPicker1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As _
                                stdole.OLE_XPOS_PIXELS, ByVal y As stdole.OLE_YPOS_PIXELS)
  With DTPicker1
    If .Value = vbNull Then
      .Value = Now
    End If
  End With
End Sub

Private Sub FormatDTPicker()
  With DTPicker1
    If .Value = vbNull Then
      .Format = dtpCustom
      .CustomFormat = "X"
    Else
      .Format = dtpShortDate
    End If
  End With
End Sub

Private Sub CMDBTN_SAVE_Click()
    Dim wb As Workbook
    Dim datalastRow As Long
    Dim mainInvlastRow As Long
    Dim i As Integer, j As Integer, k As Integer
    Dim matchedRow As Long
    Dim matched As Boolean
        
    Set wb = ThisWorkbook
    datalastRow = WorksheetFunction.Max(4, wb.Sheets("Data").Cells(Rows.count, "A").End(xlUp).Row)
    mainInvlastRow = wb.Sheets("MainInventory").Cells(wb.Sheets("MainInventory").Rows.count, "B").End(xlUp).Row
        
    'Validate input for required fields
    If Me.TXTBXSURATJALAN.Value = "" Or Me.CMBBXCUSTOMER.Value = "" Or Me.DTPicker1.Value = vbNull _
        Or (Me.TXTBXTBG1.Value = "" And Me.TXTBXTBG2.Value = "" And Me.TXTBXTBG3.Value = "" _
            And Me.TXTBXTBG4.Value = "" And Me.TXTBXTBG5.Value = "" And Me.TXTBXTBG6.Value = "" _
            And Me.TXTBXTBG7.Value = "" And Me.TXTBXTBG8.Value = "" And Me.TXTBXTBG9.Value = "" _
            And Me.TXTBXTBG10.Value = "" And Me.TXTBXTBG11.Value = "" And Me.TXTBXTBG12.Value = "" _
            And Me.TXTBXTBG13.Value = "" And Me.TXTBXTBG14.Value = "" And Me.TXTBXTBG15.Value = "" _
            And Me.TXTBXTBG16.Value = "" And Me.TXTBXTBG17.Value = "" And Me.TXTBXTBG18.Value = "" _
            And Me.TXTBXTBG19.Value = "" And Me.TXTBXTBG20.Value = "" And Me.TXTBXTBG21.Value = "" _
            And Me.TXTBXTBG22.Value = "" And Me.TXTBXTBG23.Value = "" And Me.TXTBXTBG24.Value = "" _
            And Me.TXTBXTBG25.Value = "" And Me.TXTBXTBG26.Value = "" And Me.TXTBXTBG27.Value = "" _
            And Me.TXTBXTBG28.Value = "" And Me.TXTBXTBG29.Value = "" And Me.TXTBXTBG30.Value = "" _
            And Me.TXTBXTBG31.Value = "" And Me.TXTBXTBG32.Value = "" And Me.TXTBXTBG33.Value = "" _
            And Me.TXTBXTBG34.Value = "" And Me.TXTBXTBG35.Value = "" And Me.TXTBXTBG36.Value = "" _
            And Me.TXTBXTBG37.Value = "" And Me.TXTBXTBG38.Value = "" And Me.TXTBXTBG39.Value = "" _
            And Me.TXTBXTBG40.Value = "") Then
        Beep 'play a beep sound for error message
        MsgBox "Harap isi semua kolom yang ada tanda ""*"" (bintang).", vbExclamation + vbOKOnly, "Error"
        Exit Sub
    End If
    
    ' Write data to the next empty row
    wb.Sheets("Data").Range("A" & datalastRow + 1).Value = Me.DTPicker1.Value
    wb.Sheets("Data").Range("B" & datalastRow + 1).Value = Me.TXTBXCATATAN.Value
    wb.Sheets("Data").Range("C" & datalastRow + 1).Value = Me.TXTBXSURATJALAN.Value
    wb.Sheets("Data").Range("D" & datalastRow + 1).Value = Me.CMBBXCUSTOMER.Value
    wb.Sheets("Data").Range("E" & datalastRow + 1).Value = Me.TXTBXTBG1.Value
    wb.Sheets("Data").Range("F" & datalastRow + 1).Value = Me.TXTBXTBG2.Value
    wb.Sheets("Data").Range("G" & datalastRow + 1).Value = Me.TXTBXTBG3.Value
    wb.Sheets("Data").Range("H" & datalastRow + 1).Value = Me.TXTBXTBG4.Value
    wb.Sheets("Data").Range("I" & datalastRow + 1).Value = Me.TXTBXTBG5.Value
    wb.Sheets("Data").Range("J" & datalastRow + 1).Value = Me.TXTBXTBG6.Value
    wb.Sheets("Data").Range("K" & datalastRow + 1).Value = Me.TXTBXTBG7.Value
    wb.Sheets("Data").Range("L" & datalastRow + 1).Value = Me.TXTBXTBG8.Value
    wb.Sheets("Data").Range("M" & datalastRow + 1).Value = Me.TXTBXTBG9.Value
    wb.Sheets("Data").Range("N" & datalastRow + 1).Value = Me.TXTBXTBG10.Value
    wb.Sheets("Data").Range("O" & datalastRow + 1).Value = Me.TXTBXTBG11.Value
    wb.Sheets("Data").Range("P" & datalastRow + 1).Value = Me.TXTBXTBG12.Value
    wb.Sheets("Data").Range("Q" & datalastRow + 1).Value = Me.TXTBXTBG13.Value
    wb.Sheets("Data").Range("R" & datalastRow + 1).Value = Me.TXTBXTBG14.Value
    wb.Sheets("Data").Range("S" & datalastRow + 1).Value = Me.TXTBXTBG15.Value
    wb.Sheets("Data").Range("T" & datalastRow + 1).Value = Me.TXTBXTBG16.Value
    wb.Sheets("Data").Range("U" & datalastRow + 1).Value = Me.TXTBXTBG17.Value
    wb.Sheets("Data").Range("V" & datalastRow + 1).Value = Me.TXTBXTBG18.Value
    wb.Sheets("Data").Range("W" & datalastRow + 1).Value = Me.TXTBXTBG19.Value
    wb.Sheets("Data").Range("X" & datalastRow + 1).Value = Me.TXTBXTBG20.Value
    wb.Sheets("Data").Range("Y" & datalastRow + 1).Value = WorksheetFunction.CountA(Range("E" & datalastRow + 1 & ":Y" & datalastRow + 1))
    wb.Sheets("Data").Range("AA" & datalastRow + 1).Value = Me.TXTBXTBG21.Value
    wb.Sheets("Data").Range("AB" & datalastRow + 1).Value = Me.TXTBXTBG22.Value
    wb.Sheets("Data").Range("AC" & datalastRow + 1).Value = Me.TXTBXTBG23.Value
    wb.Sheets("Data").Range("AD" & datalastRow + 1).Value = Me.TXTBXTBG24.Value
    wb.Sheets("Data").Range("AE" & datalastRow + 1).Value = Me.TXTBXTBG25.Value
    wb.Sheets("Data").Range("AF" & datalastRow + 1).Value = Me.TXTBXTBG26.Value
    wb.Sheets("Data").Range("AG" & datalastRow + 1).Value = Me.TXTBXTBG27.Value
    wb.Sheets("Data").Range("AH" & datalastRow + 1).Value = Me.TXTBXTBG28.Value
    wb.Sheets("Data").Range("AI" & datalastRow + 1).Value = Me.TXTBXTBG29.Value
    wb.Sheets("Data").Range("AJ" & datalastRow + 1).Value = Me.TXTBXTBG30.Value
    wb.Sheets("Data").Range("AK" & datalastRow + 1).Value = Me.TXTBXTBG31.Value
    wb.Sheets("Data").Range("AL" & datalastRow + 1).Value = Me.TXTBXTBG32.Value
    wb.Sheets("Data").Range("AM" & datalastRow + 1).Value = Me.TXTBXTBG33.Value
    wb.Sheets("Data").Range("AM" & datalastRow + 1).Value = Me.TXTBXTBG34.Value
    wb.Sheets("Data").Range("AO" & datalastRow + 1).Value = Me.TXTBXTBG35.Value
    wb.Sheets("Data").Range("AP" & datalastRow + 1).Value = Me.TXTBXTBG36.Value
    wb.Sheets("Data").Range("AQ" & datalastRow + 1).Value = Me.TXTBXTBG37.Value
    wb.Sheets("Data").Range("AR" & datalastRow + 1).Value = Me.TXTBXTBG38.Value
    wb.Sheets("Data").Range("AS" & datalastRow + 1).Value = Me.TXTBXTBG39.Value
    wb.Sheets("Data").Range("AT" & datalastRow + 1).Value = Me.TXTBXTBG40.Value
    wb.Sheets("Data").Range("AU" & datalastRow + 1).Value = WorksheetFunction.CountA(Range("AA" & datalastRow + 1 & ":AT" & datalastRow + 1))

        For i = 1 To 40
        matched = False
        If Me.Controls("TXTBXTBG" & i).Value <> "" Then
            For j = 4 To mainInvlastRow
                If wb.Sheets("MainInventory").Cells(j, "B").Value = Me.Controls("TXTBXTBG" & i).Value Then
                    matchedRow = j
                    matched = True
                    Exit For
                End If
            Next j
                
            If matched Then
                If i <= 20 Then
                    wb.Sheets("MainInventory").Cells(matchedRow, "D").Value = Me.CMBBXCUSTOMER.Value
                Else
                    wb.Sheets("MainInventory").Cells(matchedRow, "D").Value = "Gudang"
                End If
            End If
        End If
    Next i

    'Clear the input fields on the userform
    Me.TXTBXCATATAN.Value = ""
    Me.TXTBXSURATJALAN.Value = ""
    Me.CMBBXCUSTOMER.Value = ""
    Me.TXTBXTBG1.Value = ""
    Me.TXTBXTBG2.Value = ""
    Me.TXTBXTBG3.Value = ""
    Me.TXTBXTBG4.Value = ""
    Me.TXTBXTBG5.Value = ""
    Me.TXTBXTBG6.Value = ""
    Me.TXTBXTBG7.Value = ""
    Me.TXTBXTBG8.Value = ""
    Me.TXTBXTBG9.Value = ""
    Me.TXTBXTBG10.Value = ""
    Me.TXTBXTBG11.Value = ""
    Me.TXTBXTBG12.Value = ""
    Me.TXTBXTBG13.Value = ""
    Me.TXTBXTBG14.Value = ""
    Me.TXTBXTBG15.Value = ""
    Me.TXTBXTBG16.Value = ""
    Me.TXTBXTBG17.Value = ""
    Me.TXTBXTBG18.Value = ""
    Me.TXTBXTBG19.Value = ""
    Me.TXTBXTBG20.Value = ""
    Me.TXTBXTBG21.Value = ""
    Me.TXTBXTBG22.Value = ""
    Me.TXTBXTBG23.Value = ""
    Me.TXTBXTBG24.Value = ""
    Me.TXTBXTBG25.Value = ""
    Me.TXTBXTBG26.Value = ""
    Me.TXTBXTBG27.Value = ""
    Me.TXTBXTBG28.Value = ""
    Me.TXTBXTBG29.Value = ""
    Me.TXTBXTBG30.Value = ""
    Me.TXTBXTBG31.Value = ""
    Me.TXTBXTBG32.Value = ""
    Me.TXTBXTBG33.Value = ""
    Me.TXTBXTBG34.Value = ""
    Me.TXTBXTBG35.Value = ""
    Me.TXTBXTBG36.Value = ""
    Me.TXTBXTBG37.Value = ""
    Me.TXTBXTBG38.Value = ""
    Me.TXTBXTBG39.Value = ""
    Me.TXTBXTBG40.Value = ""
    Beep 'play a beep sound for success message
    MsgBox "Input Data Berhasil.", vbInformation + vbOKOnly, "Success" 'Display pop up message when data input success

End Sub

Public Sub CMDBTN_CANCEL_Click()
    ' Check if any of the fields are filled
    Dim anyFieldFilled As Boolean
    anyFieldFilled = False
    Dim i As Integer
    For i = 1 To 40
        If Me.Controls("TXTBXTBG" & i).Value <> "" Then
            anyFieldFilled = True
            Exit For
        End If
    Next i
    If Me.TXTBXCATATAN.Value <> "" Or Me.TXTBXSURATJALAN.Value <> "" Or Me.CMBBXCUSTOMER.Value <> "" Or anyFieldFilled = True Then
        ' Clear all fields
        Me.TXTBXCATATAN.Value = ""
        Me.TXTBXSURATJALAN.Value = ""
        Me.CMBBXCUSTOMER.Value = ""
        For i = 1 To 40
            Me.Controls("TXTBXTBG" & i).Value = ""
        Next i
    Else
        ' Ask for confirmation before closing the form
        If MsgBox("Do you want to close the form?", vbQuestion + vbYesNo, "Close Form") = vbYes Then
            Unload Me
        End If
    End If
End Sub