Scribd
Upload
15 views

Scrib Kode

This document contains code for a userform in VBA that activates when opened. It sets the maximum value from a cell and focuses on a text box. There is also code to input data by finding the next empty row, checking for duplicate numbers, and copying the input data to the database worksheet if no duplicate is found.

Uploaded by

ASrul ABDmuin
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as DOCX, PDF, TXT or read online on Scribd
15 views

Scrib Kode

This document contains code for a userform in VBA that activates when opened. It sets the maximum value from a cell and focuses on a text box. There is also code to input data by finding the next empty row, checking for duplicate numbers, and copying the input data to the database worksheet if no duplicate is found.

Uploaded by

ASrul ABDmuin
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as DOCX, PDF, TXT or read online on Scribd
You are on page 1/ 2

Private Sub UserForm_Activate()

Dim Ws As Worksheet

Set Ws = Worksheet("DATABASE")

txtMAX.Value = Range("A1").Value

txtNO.SetFocus

End Sub

'menyimpan data

Private Sub cmdINPUT_Clik()

Dim iRow As Long

Dim Ws As Worksheet

Set Ws = Worksheet("DATABASE")

'menentukan baris kosong pada database

iRow = Ws.Cells(Rows.Count, 1) _

.End(x1Up).Offset(1, 0).Row

'Cek untuk sebuah kode

If Trim(Me.txtNO.Value) = "" Then

Me.txtNO.SetFocus

MsgBox "TIDAK MENGOSONGKAN NOMOR URUT"

Exit Sub

End If

'menemukan nomor yang sama

Dta = Me.txtNO.Value
With Worksheet("DATABASE").Range("A5:A200")

Set C = .Find(Data, LookIn = "xIFormulas")

If C Is Nothing Then

MsgBox "CEK NOMOR URUT IS OKE"

Else

MsgBox "NOMOR URUT SUDAH ADA"

Me.txtNO.Value = ""

Me.txtNO.SetFocus

Exit Sub

End If

End With

'Copy data ke database

Ms.Cells(iRows, 1).Value = Me.txtNO.Value

Ms.Cells(iRows, 2).Value = Me.txtKK.Value

Ms.Cells(iRows, 3).Value = Me.txtNAMA.Value

Ms.Cells(iRows, 4).Value = Me.txtNIK.Value

You might also like