Aplikasi Entri data Penduduk

KODE  INPUT

 Private Sub CommandButton1_Click()

Dim iRow As Long

iRow = Sheets("DATA").Cells(Rows.Count, 4).End(xlUp).Offset(1, 0).row

Sheets("DATA").Cells(iRow, 3).Value = TextBox13.Value

Sheets("DATA").Cells(iRow, 4).Value = ("'" & TextBox1.Value)

Sheets("DATA").Cells(iRow, 5).Value = TextBox2.Value

Sheets("DATA").Cells(iRow, 6).Value = ("'" & TextBox3.Value)

Sheets("DATA").Cells(iRow, 7).Value = ComboBox1.Value

Sheets("DATA").Cells(iRow, 8).Value = ComboBox2.Value

Sheets("DATA").Cells(iRow, 9).Value = TextBox4.Value

Sheets("DATA").Cells(iRow, 10).Value = TextBox22.Value

Sheets("DATA").Cells(iRow, 11).Value = ComboBox3.Value

Sheets("DATA").Cells(iRow, 12).Value = ComboBox4.Value

Sheets("DATA").Cells(iRow, 13).Value = ComboBox5.Value

Sheets("DATA").Cells(iRow, 14).Value = ComboBox6.Value

Sheets("DATA").Cells(iRow, 15).Value = TextBox6.Value

Sheets("DATA").Cells(iRow, 16).Value = TextBox7.Value

Sheets("DATA").Cells(iRow, 17).Value = TextBox8.Value

Sheets("DATA").Cells(iRow, 18).Value = TextBox9.Value

Sheets("DATA").Cells(iRow, 19).Value = TextBox10.Value

Sheets("DATA").Cells(iRow, 20).Value = TextBox11.Value

Sheets("DATA").Cells(iRow, 21).Value = ComboBox7.Value

Sheets("DATA").Cells(iRow, 22).Value = TextBox12.Value

End Sub

KODE EDIT

Private Sub CommandButton8_Click()

Data = NOMOR.Value

With Sheets("Data").Range("B8:B6000")

Set c = .Find(Data, LookIn:=xlValues)

If TextBox1.Value = "" Then

 MsgBox "nama belum terdaftar", vbCritical

ElseIf Not c Is Nothing Then

BARIS = c.row

Sheets("Data").Cells(BARIS, 3).Value = TextBox13.Value

Sheets("Data").Cells(BARIS, 4).Value = TextBox1.Value

Sheets("Data").Cells(BARIS, 5).Value = TextBox2.Value

Sheets("Data").Cells(BARIS, 6).Value = TextBox3.Value

Sheets("Data").Cells(BARIS, 7).Value = ComboBox1.Value

Sheets("Data").Cells(BARIS, 8).Value = ComboBox2.Value

Sheets("Data").Cells(BARIS, 9).Value = TextBox4.Value

Sheets("Data").Cells(BARIS, 10).Value = TextBox5.Value

Sheets("Data").Cells(BARIS, 11).Value = ComboBox3.Value

Sheets("Data").Cells(BARIS, 12).Value = ComboBox4.Value

Sheets("Data").Cells(BARIS, 13).Value = ComboBox5.Value

Sheets("Data").Cells(BARIS, 14).Value = ComboBox6.Value

Sheets("Data").Cells(BARIS, 15).Value = TextBox6.Value

Sheets("Data").Cells(BARIS, 16).Value = TextBox7.Value

Sheets("Data").Cells(BARIS, 17).Value = TextBox8.Value

Sheets("Data").Cells(BARIS, 18).Value = TextBox9.Value

Sheets("Data").Cells(BARIS, 19).Value = TextBox10.Value

Sheets("Data").Cells(BARIS, 20).Value = TextBox11.Value

Sheets("Data").Cells(BARIS, 21).Value = ComboBox7.Value

Sheets("Data").Cells(BARIS, 22).Value = TextBox12.Value

End If

End With

KOSONG_Click

End Sub

KODE PENOMORAN

Private Sub CommandButton12_Click()

'PENOMORAN

Dim Sr As Long

Range("A9").Value = "= IF(COUNTIF(C8:C9,C9)=2,0,IF(COUNTIF(C8:C9,C9)=1,C9,0))"

Sr = Range("j" & Rows.Count).End(xlUp).row

Range("A9: " & "A" & Sr).FillDown

'-------------------------------------

'NOMOR__URUT

Range("a1") = Application.CountA(Range("E8:E3000")) + 1

No = 1

For xx = 1 To Range("a1")

No = No + 1

Cells(No + 7, 2).Value = No

Next xx

'-----------------------------------------

'Copy formula

Dim x As Worksheet, LastRow&

Set x = Worksheets("DATA")

LastRow = x.Cells.SpecialCells(xlCellTypeLastCell).row

x.Range("A8:C" & LastRow).Copy

x.Range("A8:C" & LastRow).PasteSpecial Paste:=xlPasteValues

x.Range("W8:X" & LastRow).Copy

x.Range("W8:X" & LastRow).PasteSpecial Paste:=xlPasteValues

Application.CutCopyMode = False

TextBox28.Value = Sheets("DATA").Cells(6, 5).Value

TextBox29.Value = Sheets("DATA").Cells(6, 6).Value

TextBox30.Value = Sheets("DATA").Cells(6, 7).Value

End Sub

HITUNG UMUR

Private Sub CommandButton16_Click()

' UMUR

Range("x1").Value = "y"

Range("W1").Value = Now()

Dim SB As Long

Range("X8").Value = "=IF(E8<>0,DATEDIF(J8,$w$1,$x$1),0)"

SB = Range("J" & Rows.Count).End(xlUp).row

Range("W8: " & "x" & SB).FillDown

'----------------------------------------

End Sub

 KODE BORDER

Private Sub CommandButton3_Click()

'Border

Dim LastRow As Long, LastCol As Long

  Cells.Borders.LineStyle = xlNone

  LastRow = Cells.Find("*", , xlValues, , xlRows, xlPrevious).row

  LastCol = Cells.Find("*", , xlValues, , xlByColumns, xlPrevious).Column

  With Range("A7", Cells(LastRow, LastCol))

    .BorderAround xlDouble

    .Rows.Borders(xlInsideHorizontal).LineStyle = xlDash

    .Rows.Borders(xlInsideVertical).LineStyle = xlContinuous

    .Font.FontStyle = "Italic"

    .Font.Size = 11

  End With

'Pewarnaan Kepala Keluarga

Worksheets("data").Range("a8:X3000").Interior.ColorIndex = 2

   Dim i As Long, r1 As Range, r2 As Range

   For i = 8 To Range("A1") + 7

      Set r1 = Range("G" & i)

      Set r2 = Range("A" & i & ":X" & i)

      If r1.Value = "Kepala Keluarga" Then r2.Interior.ColorIndex = 35

      If r1.Value = "Istri" Then r2.Interior.ColorIndex = 34

   Next i

End Sub

UNDUH SAMPE FILE XLSM  >> FORM ENTRI DATA PENDUDUK