Untitled

mail@pastecode.io avatar
unknown
plain_text
a year ago
3.3 kB
0
Indexable
Never
Private Sub CMDBTN_SAVE_Click()

' Declare variables
    Dim dateValue As Date
    Dim catatanValue As String
    Dim suratjalanValue As String
    Dim customerValue As String
    Dim tbgValues(1 To 40) As String
    Dim i As Integer
        
' Get form field values
    dateValue = DTPicker1.Value
    catatanValue = TXTBXCATATAN.Text
    suratjalanValue = TXTBXSURATJALAN.Text
    customerValue = CMBBXCUSTOMER.Text
        
    For i = 1 To 40
        tbgValues(i) = Me.Controls("TXTBXTBG" & i).Text
    Next i
        
' Validate required fields
    Dim missingFields As String
    If dateValue = vbNull Then
        missingFields = "Tanggal"
    End If
    If suratjalanValue = "" Then
        If missingFields = "" Then
            missingFields = "Surat Jalan"
        Else
            missingFields = missingFields & ", Surat Jalan"
        End If
    End If
    If customerValue = "" Then
        If missingFields = "" Then
            missingFields = "Customer"
        Else
            missingFields = missingFields & ", Customer"
        End If
    End If
    Dim isTbgFilled As Boolean
    For i = 1 To 40
        If tbgValues(i) <> "" Then
            isTbgFilled = True
            Exit For
        End If
    Next i
    If Not isTbgFilled Then
        If missingFields = "" Then
            missingFields = "Minimal 1 kolom 'TBG'"
        Else
            missingFields = missingFields & ", Minimal 1 kolom 'TBG'"
        End If
    End If
    If missingFields <> "" Then
        Beep
        MsgBox "Harap isi semua kolom yang ada tanda ""*"" (bintang): " & missingFields & ".", vbExclamation + vbOKOnly, "Error"
        Exit Sub
    End If

' Check if any tbg value matches MainInventory column B
    Dim matchRow As Long
    For i = 1 To 40
        If tbgValues(i) <> "" Then
            matchRow = WorksheetFunction.Match(tbgValues(i), ThisWorkbook.Sheets("MainInventory").Range("B4:B1000"), 0)
            If Not IsError(matchRow) Then
                Exit For
            End If
        End If
    Next i
    
' Update corresponding data in MainInventory
    If Not IsError(matchRow) Then
        If matchRow >= 4 And matchRow <= 1000 Then
            If tbgValues(1) <> "" Or tbgValues(2) <> "" Then
                ThisWorkbook.Sheets("MainInventory").Cells(matchRow, 3).Value = customerValue
            ElseIf tbgValues(3) <> "" Or tbgValues(4) <> "" Then
                ThisWorkbook.Sheets("MainInventory").Cells(matchRow, 3).Value = "Gudang"
            End If
        End If
    End If
    
' Write data to Data sheet
    Dim dataSheet As Worksheet
    Set dataSheet = ThisWorkbook.Sheets("Data")
    
    Dim lastRow As Long
    lastRow = dataSheet.Cells(Rows.count, 1).End(xlUp).Row
    
    dataSheet.Cells(lastRow + 1, 1).Value = dateValue
    dataSheet.Cells(lastRow + 1, 2).Value = catatanValue
    dataSheet.Cells(lastRow + 1, 3).Value = suratjalanValue
    dataSheet.Cells(lastRow + 1, 4).Value = customerValue
    
    Dim tbgStartCol As Integer
    tbgStartCol = 4 ' Starting column for TBG values
    
    For i = 1 To 40
        dataSheet.Cells(lastRow + 1, tbgStartCol + i - 1).Value = tbgValues(i)
    Next i
    
' Play success sound and show message box
    Beep
    MsgBox "Input Data Berhasil.", vbInformation + vbOKOnly, "Success"
End Sub