Input Pilih sheets dgn Combobox

Form Input Pilih sheets
dengan Combobox Control

Private Sub CommandButton5_Click()
Pilihan pada combobox1
If ComboBox1.Text = "Kelas1" Then
Sheets("data1").Select
ElseIf ComboBox1.Text = "Kelas2" Then
Sheets("data2").Select
ElseIf ComboBox1.Text = "Kelas3" Then
Sheets("data3").Select
End If
‘Menuju ke sheet aktif
ActiveSheet.Range(Selection, Cells(1, 1)).Select
Mengisi baris kosong terakhir
Dim irow As Long
irow = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Offset(1, 1).row
ActiveSheet.Cells(irow, 2).Value = TextBox1.Value
ActiveSheet.Cells(irow, 3).Value = TextBox2.Value
ActiveSheet.Cells(irow, 4).Value = TextBox3.Value
ActiveSheet.Cells(irow, 5).Value = TextBox4.Value
ActiveSheet.Cells(irow, 6).Value = TextBox5.Value
End Sub

Download contoh sampelnya file xlsm pada tautan berikut dibawah ini !

Silahkan dikembangkan dan Semoga bermanfaat !

SAMPEL FILE

Input dan interior color

Input interior color
Kode Input Pastekan Kode Pada CommandButton1

Private Sub CommandButton1_Click()
Dim iRow As Long
Sheets("Sheet1").Activate
iRow = WorksheetFunction.CountA(Range("b:b")) + 5
Cells(iRow, 2).Value = TextBox1.Value
Cells(iRow, 3).Value = TextBox2.Value
Cells(iRow, 4).Value = TextBox3.Value
Cells(iRow, 5).Value = TextBox4.Value
Cells(iRow, 6).Value = TextBox5.Value

Mewarnai Interior oleh TextBox6
Cells(iRow, 2).Interior.ColorIndex = TextBox6.Value
Cells(iRow, 3).Interior.ColorIndex = TextBox6.Value
Cells(iRow, 4).Interior.ColorIndex = TextBox6.Value
Cells(iRow, 5).Interior.ColorIndex = TextBox6.Value
Cells(iRow, 6).Interior.ColorIndex = TextBox6.Value

Mewarnai tex TextBox7
Cells(iRow, 2).Font.ColorIndex = TextBox7.Value
Cells(iRow, 3).Font.ColorIndex = TextBox7.Value
Cells(iRow, 4).Font.ColorIndex = TextBox7.Value
Cells(iRow, 5).Font.ColorIndex = TextBox7.Value
Cells(iRow, 6).Font.ColorIndex = TextBox7.Value
End Sub


Mengisi nilai di TextBox6 oleh SpinButton1
Private Sub SpinButton1_Change()
TextBox6.Value = SpinButton1
End Sub
Mengisi nilai di TextBox7 oleh SpinButton2
Private Sub SpinButton2_Change()
TextBox7.Value = SpinButton2
End Sub

Input Kreteria Multi Tabel baris

Input interior color
Kode Input Pastekan Kode Pada CommandButton1

Private Sub CommandButton1_Click()
Dim iRow As Long
Sheets("Sheet1").Activate
iRow = WorksheetFunction.CountA(Range("b:b")) + 5
Cells(iRow, 2).Value = TextBox1.Value
Cells(iRow, 3).Value = TextBox2.Value
Cells(iRow, 4).Value = TextBox3.Value
Cells(iRow, 5).Value = TextBox4.Value
Cells(iRow, 6).Value = TextBox5.Value

Mewarnai Interior oleh TextBox6
Cells(iRow, 2).Interior.ColorIndex = TextBox6.Value
Cells(iRow, 3).Interior.ColorIndex = TextBox6.Value
Cells(iRow, 4).Interior.ColorIndex = TextBox6.Value
Cells(iRow, 5).Interior.ColorIndex = TextBox6.Value
Cells(iRow, 6).Interior.ColorIndex = TextBox6.Value

Mewarnai tex TextBox7
Cells(iRow, 2).Font.ColorIndex = TextBox7.Value
Cells(iRow, 3).Font.ColorIndex = TextBox7.Value
Cells(iRow, 4).Font.ColorIndex = TextBox7.Value
Cells(iRow, 5).Font.ColorIndex = TextBox7.Value
Cells(iRow, 6).Font.ColorIndex = TextBox7.Value
End Sub


Mengisi nilai di TextBox6 oleh SpinButton1
Private Sub SpinButton1_Change()
TextBox6.Value = SpinButton1
End Sub
Mengisi nilai di TextBox7 oleh SpinButton2
Private Sub SpinButton2_Change()
TextBox7.Value = SpinButton2
End Sub

VBA Form Input Pilih Multy sheet

Input multy sheet



Kode input pastekan kode pada CommandButton1

Private Sub CommandButton1_Click()
For k = 0 To ListBox1.ListCount  1 

bila kotak ceklis pilih salah satu atau semuanya
        If ListBox1.Selected(k) Then
        Sheets(ListBox1.List(k)).Select
        Sheets(ListBox1.List(k)).Cells.SpecialCells(xlLastCell).Select
        Range(Selection, Cells(1, 1)).Select
        End If
        Next
Dim iRow As Long                                           Menempatkan data input disetiap sheet pilihan
iRow = WorksheetFunction.CountA(Range("b:b")) + 5
Cells(iRow, 2).Value = TextBox1.Value
Cells(iRow, 3).Value = TextBox2.Value
Cells(iRow, 4).Value = TextBox3.Value
Cells(iRow, 5).Value = TextBox4.Value
Cells(iRow, 6).Value = TextBox5.Value
Menempatkan fungsi counta disetiap sheet pilihan  untuk member nomor urut disetiap input
    Range("A1") = Application.CountA(Range("c6:c100"))
    No = 0
    For NOMOR = 1 To Range("A1")
    No = No + 1
    Cells(No + 5, 1).Value = No
    Next NOMOR
    End Sub


 input pilih multy sheets 

Formula Index

Calkulator dgn Texbox

Membuat Kalkulator Sederhana

Nilai pada sebuah texbox di deklarasikan dengan val
Misalnya :
Val(Text2.Text) untuk nilai untuk texbox2
Dan sebagainya

Untuk menjumlahkan nilai texbox1 dan texbox2  yang hasilnya di texbox3
maka ditulis sebagai berikut :

a = Val(Text1.Text) 
b = Val(Text2.Text)
r = a + b
Text3.Text = r

Keterangan:
a dideklarasikan sebagai nilai untuk texbox1
b dideklarasikan sebagai nilai untuk texbox2
r dideklarasikan sebagai nilai untuk texbox3

maka nilai r = a + b


demikian pula untuk mencari nilai pengurangan atau perkalian akan dideklarasikan dengan contoh berikut sebagai berikut

r = a - b  mendapatkan hasil pengurangan
r = a * b  mendapatkan hasil perkalian

mari kita aplikasikan code vba tersebut untuk membuat kalkulator sederhana

cukup mudah caranya siapka sebuah userform
dengan 3 buah texbox yakni
texbox1 , texbox2 dan texbox3
4 buah Commandbutton yakni
Commandbutton1
Commandbutton2
Commandbutton3
Commandbutton4

Pastekan kode pada  CommandButton1

Private Sub CommandButton1_Click()
a = Val(Text1.Text)
b = Val(Text2.Text)
r = a + b
Text3.Text = r
End Sub

Pastekan kode pada  CommandButton2

Private Sub CommandButton2_Click()
a = Val(Text1.Text)
b = Val(Text2.Text)
r = a - b
Text3.Text = r
End Sub

Pastekan kode pada  CommandButton3


Private Sub CommandButton3_Click()
a = Val(Text1.Text)
b = Val(Text2.Text)
r = a * b
Text3.Text = r
End Sub

Pastekan kode pada  CommandButton4


Private Sub CommandButton4_Click()
a = Val(Text1.Text)
b = Val(Text2.Text)
r = a / b
Text3.Text = r
End Sub

Pastekan kode pada  sebuah modul yang nantinya digunakan untuk memanggil userform

Sub panggil ()
Userform1.show
End sub

Selesai
semoga bermanfaat

Sampel file dapat didownload di link berikut


 

Copy Paste Transpose

Tranpose array
Salah satu model copy paste yakni copy paste data baris menjadi data kolom demikian pula sebaliknya sesuai funsi bawaan excel yang dikenal dengan Copy Transpose

Namun kali ini bagaimana mengaplikasikan fungsi tersebut ke sebuah macro atau Vba
Caranya juga cukup mudah kita hanya perlu sebuah modul yang akan kita panggil dengan sebuah modul

Buatlah table seperti gambar diatas kemudian buatlah sebuah modul dan pastekan kode berikut pada modul

Namun sebelumnya sesuaikan dengan nama sheet dimana dicopy dan dimana mau dipaste
Demikian pula cell atau area yang akan menjadi target harus disesuaikan dikode pada modul
Sub Tranpose()
Worksheets("data1").Range("A2:b20").Copy
Worksheets("data1").Range("d2").PasteSpecial Transpose:=True
End Sub

Selesai
semoga bermanfaat

Sampel file dapat didownload di link berikut

Cara mengaktifkan macro

Cara mengaktifkan macro dikomputer anda

Tombol Panggil Modul

Runtime error 1004

Runtime error 1004 kadang-kadang disertai dengan teks seperti "Copy method of worksheet class failed," "Programmatic access to Visual Basic Project is not trusted," atau "Application-defined or object-defined error.". Runtime error 1004 kadang-kadang muncul saat menggunakan Microsoft Excel atau Visual Basic.
Karena file runtime dapat ditemukan dalam registri, menggunakan registry cleaner yang handal dapat memperbaiki jenis masalah ini dari pada yang lain. Ketika Anda menginstal program, menggunakan program, dan uninstall program, perubahan kecil dapat terjadi yang mengarah ke rusaknya entri dalam registri. Menggunakan registry cleaner harus dapat memperbaiki entri rusak.
1) Download registry cleaner.
2) Instal registry cleaner dengan benar benar.
3) Jalankan registry cleaner pada komputer untuk memperbaiki file yang rusak atau hilang.
How to Fix Runtime Error 1004: Visual Basic
Cukup ikuti salah satu dari set dibawah ini untuk mengatasi error yang terjadi saat menggunakan Visual Basic dalam Excel.
Set 1:
1)      Open your Microsoft Excel application.
2)      Select Tools from the top of the menu.
3)      Select Macros.
4)      Select Security.
5)      Select “Choose trusted publisher” from the Security dialog box.
6)      Select “Trust Access to Visual Basic Project.”
7)      Select Ok.
Set 2: Masalah mengcopy paste data
Mengubah kode Macro VBA sehingga hanya salinan dan paste satu baris, khususnya bagian dari baris yang berisi data.
Atau Dengan: 
Mengubah kode Macro VBA sehingga loop untuk menyalin dan sehingga paste rentang data yang lebih kecil.
How to Fix Runtime Error 1004: Microsoft Excel
Jika Anda menerima runtime error 1004 bersama dengan teks ini: "Metode pada Key Up Object_Application Gagal," coba dengan cara dibawah ini:
Right click on Start.
Select Explorer.
Open C:\Program Files\MS Office\XLSTART directory.
Delete this file: GWXL97.XLA.
Close Explorer.
Open your Microsoft Excel application.

Format Value Texbox

         Format Value Texbox

Format value sama halnya dengan format cell dilembar excel .Namun di userform pada texbox dikenal dgn format Value atau isi
Contoh beberapa format value pada texbox diantaranya

1 Format  angka 8 digit

Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
TextBox1.Value = Format(TextBox2.Value, "000000000000000")
End Sub

'2.Contoh format date atau tanggal :

Private Sub TextBox2_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
'Dim dDate As Date
dDate = DateSerial(Year(Date), Month(Date), Day(Date))
TextBox2.Value = Format(TextBox2.Value, "dd/mm/yyyy")
dDate = TextBox2Value
End Sub

'3.Contoh format Currency Mata Uang

Private Sub TextBox3_Change()
TextBox3.Value = Format(TextBox2.Value, "$#,##0.00")
End Sub

'4.Contoh format  persen

Private Sub TextBox4_Change()
TextBox4.Value = Format(TextBox2.Value, "0.00%")
End Sub

'5,Contoh format  menit

Private Sub TextBox5_Change()
TextBox5.Value = Format(TextBox5.Value, " h:mm:ss AM/PM;@")
End Sub

Selesai
Semoga bermanfaat

Tombol Pintasan Keyboard

Combobox Bertingkat

            Combobox Bertingkat

Pembahasan kali ini adalah bagaimana Menampilkan Isian List pada Beberapa Combobox yang saling berkaitan antar combobox satu dengan yang lain dan memenuhi kretria yg sdh ditentukan
Misalnya list yang tampil di combobok2 harus sesuai pilihan yg diberikan oleh combobox1
Demikian pula list yang tampil di combobox3 harus sesuai dengan pilihan yg diberikan oleh combobox2
Sistem Seperti ini disebut Orang dengan “ Combobox Bertingkat “

Cara Membuatnya  mari ikuti langkah – langkah berikut :
Buatlah sebuah Userform dan  Sebuah Tabel di sheet1 seperti gambar1 dan gambar2 diatas kemudian buatlah 3 combobox Yang terdiri dari

ComboBox1
ComboBox2
ComboBox3

Buatlah Tabel listdi sheet1 seperti gambar2 diatas

Pastekan Kode berikut pada ComboBox1

Private Sub ComboBox1_Change()
ComboBox2.Text = ""
ComboBox3.Text = ""
If ComboBox1.Text = Sheets("sheet1").Range("a2").Value Then
ComboBox2.List = Sheet1.Range("B5:B7").Value
ElseIf ComboBox1.Text = Sheets("sheet1").Range("a3").Value Then
ComboBox2.List = Sheet1.Range("b8:b10").Value
ElseIf ComboBox1.Text = Sheets("sheet1").Range("a4").Value Then
ComboBox2.List = Sheet1.Range("b11:b13").Value
End If
End Sub

Pastekan Kode berikut pada ComboBox2


Private Sub ComboBox2_Change()
ComboBox3.Text = ""
If ComboBox2.Text = Sheets("sheet1").Range("B5").Value Then
ComboBox3.List = Application.Transpose(Sheet1.Range("d5:m5").Value)

ElseIf ComboBox2.Text = Sheets("sheet1").Range("B6").Value Then
ComboBox3.List = Application.Transpose(Sheet1.Range("d6:m6").Value)

ElseIf ComboBox2.Text = Sheets("sheet1").Range("B7").Value Then
ComboBox3.List = Application.Transpose(Sheet1.Range("d7:m7").Value)

ElseIf ComboBox2.Text = Sheets("sheet1").Range("B8").Value Then
ComboBox3.List = Application.Transpose(Sheet1.Range("d8:m8").Value)

ElseIf ComboBox2.Text = Sheets("sheet1").Range("B9").Value Then
ComboBox3.List = Application.Transpose(Sheet1.Range("d9:m9").Value)

ElseIf ComboBox2.Text = Sheets("sheet1").Range("B10").Value Then
ComboBox3.List = Application.Transpose(Sheet1.Range("d10:m10").Value)

ElseIf ComboBox2.Text = Sheets("sheet1").Range("B11").Value Then
ComboBox3.List = Application.Transpose(Sheet1.Range("d11:m11").Value)

ElseIf ComboBox2.Text = Sheets("sheet1").Range("B12").Value Then
ComboBox3.List = Application.Transpose(Sheet1.Range("d12:m12").Value)

ElseIf ComboBox2.Text = Sheets("sheet1").Range("B13").Value Then
ComboBox3.List = Application.Transpose(Sheet1.Range("d13:m13").Value)
End If
End Sub

Pastekan Kode berikut pada useform

Private Sub UserForm_Initialize()
ComboBox1.List = Sheet1.Range("a2:a4").Value
End Sub

Selesai
Semoga bermanfaat
Sampel file dapat di unduh pada link dibawah ini





 Combobox Bertingkat 

Rekap Multy file

                Rekap Multy file

Kadang Kita membutuhkan data yang disimpan pada sebuah file d idokumen atau di sebuah folder yang berbeda namun kita ingin data yang dimaksud dapat terkumpul menjadi satu dalam bnentuk rekap halaman  di sheet active

Caranya cukup kita membuat sebuah modul dan pastekan kode berikut yang selanjutnya akan dipanggil dengan  sebuah tombol
Kode lengkapnya adalah :

Sub kumpulkan()
FileTerpilih = Application.GetOpenFilename _
("XLSX File (*.xlsx),*.xlsx", Title:="Open file", MultiSelect:=True)
If VarType(FileTerpilih) = vbBoolean Then
Exit Sub
End If
NamaFileUtama = ActiveWorkbook.Name
JumlahFile = UBound(FileTerpilih)
Application.DisplayAlerts = False
For i = 1 To JumlahFile
Workbooks.Open FileTerpilih(i)
With ActiveWorkbook.Worksheets("data1")
BarisTerakhirFilePilihan = .Cells(.Rows.Count, 1).End(xlUp).Row
BarisTerakhirFileUtama = Workbooks(NamaFileUtama).Worksheets("Sheet1") _
.Cells(Workbooks(NamaFileUtama).Worksheets("sheet1").Rows.Count, 1).End(xlUp).Row
   .Range("A6:M" & BarisTerakhirFilePilihan).Copy _
Destination:=Workbooks(NamaFileUtama).Worksheets("Sheet1").Range("A" & BarisTerakhirFileUtama + 1)
        End With
         ActiveWorkbook.Close
Next i
Application.DisplayAlerts = True
End Sub

Perlu diketahui :
Mengacu pada kode diatas syarat utama adalah active adalah
Sheet1 sebagai tempat penyimpanan atau dikumpulkan kemudian 
sheet yang akan di impor adalah sheet yang bernama  DATA1
Semua sheets disetiap file dimana saja atau di folder mana pun

Untuk reset atau akan mengulang kembali pastekan kode ini juga pada sebuah modul :

Sub RESET()
Sheets("Sheet1").Range("a3:m1000").Clear
End Sub

Selesai
Semoga bermanfaat
Sampel file dapat di unduh pada link dibawah ini



 Rekap Multy File 

Combobox List Pilihan

           Combobox Pilihan List

Membuat list pilihan pada combobox cukup mudah caranya
Buatlah userform dan table disheet1 seperti gambar diatas
Kemudian pastekan  kode vba berikut ini :

pada CommandButton1

Private Sub ComboBox1_Change()
CommandButton1_Click
End Sub

pada CommandButton1

Private Sub CommandButton1_Click()
If ComboBox1.Text = "Sultra" Then
ComboBox2.Text = ""
ComboBox2.List = Sheet1.Range("B5:B20").Value
ElseIf ComboBox1.Text = "Bali" Then
ComboBox2.Text = ""
ComboBox2.List = Sheet1.Range("C5:C20").Value
End If
End Sub

pada userform

Private Sub UserForm_Initialize()
ComboBox1.AddItem "Sultra"
ComboBox1.AddItem "Bali"
End Sub


Selesai
Semoga bermanfaat
Dapatkan sampel file pada link dibawah ini

APLIKASI KALKULATOR SERBA GUNA GRATIS VERSI EXCEL VBA

UNDUH APLIKASI DENGAN GRATIS :
Multy calculate

SEMOGA BERMANFAAT !

Convert Zero to Chart

          Conver Zero to chart

Materi kali ini adalah bagaimana mengubah nilai 0 Atau kosong Menjadi karakter
Misalnya menjadi stip, garis atau lainnya
Caranya buatlah table seperti gambar diatas
Pastekan kode berikut pada sebuagh modul:
Yang sebelumnya kita sudah membuat nama range misalnya myTabel
Yang akan menyesuaikan dengan kode macro yg ada di modul

Sub ResetValuesToZero()
    For Each n In Worksheets("Sheet2").Range("myTabel")
        If n.Value < 1 Then
            n.Value = "-"
        End If
    Next n
End Sub

Keterangan :
Karakter dapat diganti sesuai keperluan nya pada kode valuenya
Yakni :

            n.Value = "-"
            n.Value = "@"
            n.Value = "-,-"
            n.Value = "…"
            n.Value = "…?"

Selesai
Semoga bermanfaat
Dapatkan Tutorial dan Paket Belajar full VBA melalui kontak langsung WA 082 396 256 577

File sampel dapatkan melalui link dibawah ini




 Conver Zero to Chart 

Uniquie List

              Unique List

Materi kali ini adalah bagaimana membuat list unik dengan menampilkan satu data dari  daftar data yang sama atau ganda
Caranya buatlah table seperti gambar diatas
Kemudian kita biasa menggunakan beberapa cara pertama dengan fasilitas vba, seperti biasa kita akan menempatkan kode dibawah ini pada sebuah modul yang akan kita panggil dengan sebuah tombol

Option Explicit
Sub buatList()
Dim lastrow As Long
lastrow = Cells(Rows.Count, "B").End(xlUp).Row
      ActiveSheet.Range("B2:B" & lastrow).AdvancedFilter _
    Action:=xlFilterCopy, _
    CopyToRange:=ActiveSheet.Range("D2"), _
    UNIQUE:=True
     End Sub

Cara lain yakni menempatkan rumus atau formula berikut :
Formula1 :

'=IFERROR(INDEX($B$3:$B$15, MATCH(0,COUNTIF($D$2:D2, $B$3:$B$15), 0)),"")

Formula2 :


'=IFERROR(INDEX($B$3:$B$15, MATCH(0,IF(ISBLANK($B$3:$B$15),1,COUNTIF($D$2:D2, $B$3:$B$15)), 0)),"")

Cara alternative yakni dengan fasiltas VBA dengan menempatkan kode remote Duplicate Atau hapus data ganda

Kode lengkapnya

Sub RemoveDuplicates ()
Set Rng = ThisWorkbook.Sheets(“Sheet1”).Range("B6:B300")
Rng.RemoveDuplicates Columns:=Array(1), Header:=xlYes
End Sub

Selesai
Semoga bermanfaat
Dapatkan Tutorial dan Paket Belajar full VBA melalui kontak langsung WA 082 396 256 577

Berikut sampelnya dapat diunduh dilink berikut

Validasi Data Texbox

      Validasi Data Texbox

Validasi Data pada Texbox memungkin pengguna aplikasi memenuhi persyaratan dalam melakukan input pada sebuah texbox
Misalkan seorang penggunakan harus mengimput nominal atau bukan text demikian pula harus jumlah yang diimput harus memenuhi sayar yang sdh ditentukan misalnya nominal minimal 1 juta dan sebagainya
Caranya cukup mudah
Buat sebuah form input dengan 2 buah texbox dan satu tombol input

Pada tombol input pastekan kode

Private Sub CommandButton1_Click()
Dim irow As Long
irow = Worksheets("data").Cells(Rows.Count, 2).End(xlUp).Offset(1, 1).Row
Worksheets("data").Cells(irow, 2).Value = TextBox1.Value
Worksheets("data").Cells(irow, 3).Value = TextBox2.Value
End Sub


Pada Userform pastekan kode berikut :

Private Sub TextBox2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
'Validasi angka TextBox
Select Case KeyAscii
Case Asc("0") To Asc("9")
Case Else
KeyAscii = 0
MsgBox "Maaf, hanya data berupa angka yang diijinkan", 16, "Validasi"
End Select
End Sub

Pada Texbox2 pastekan code berikut:

Private Sub TextBox2_Change()
If TextBox2 = vbNullString Then Exit Sub
If TextBox2 > 1000000 Then
MsgBox " Maaf ! Jumlah Transfer Anda lebih dari 1 juta" & vbCrLf & " Silahkan logi terlebih dahulu!", vbYesNo + vbCritical, "Caution"
TextBox2 = vbNullString
Cancel = True
End If
End Sub

Sekian silahkan di coba
Semoga bermanfaat
Tiada suatu yang susah bila tekun dipelajari
Salam

File sampel pada link berikut



 Texbox Validasi 

Copy Paste Special - VBA EXCEL

Copy paste special Format cell

Copy Color special format adalah menggunakan Kode VBA maksud Copy paste semua bentuk format akan dicopy  baik interior , value dan format cellnya jadi akan menghasil copy yang sama persis dengan aslinya

Cara  juga hanya perlu membuat sebuah modul
Pastekan kode berikut :

Sub Copy_interior()
    Range("B2:B13").Select
    Application.CutCopyMode = False
    Selection.copy
    Range("E2").Select
    Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
ThisWorkbook.Worksheets("Sheet1").Range("E:E").EntireColumn.AutoFit
        End Sub

Sub Reset()
With ActiveSheet
ActiveSheet.Columns("E:E").Select
Selection.Delete Shift:=xlToLeft
End With
End Sub

Sub CopyFormat_last_Row()

Sheets("Sheet1").Range("a2:d10").Copy

Sheets("Sheet2").Cells(Cells.Rows.Count, 1).End(xlUp).Offset(2, 0).PasteSpecial Paste:=xlPasteAllUsingSourceTheme

End Sub

Berikut pilihan jenis copy special :

PasteSpecial Paste:=xlPasteAllUsingSourceTheme

          Hasil copy sama persis dgn aslinya

PasteSpecial Transpose:=True

         Hasil copy transpose

PasteSpecial Paste:=xlPasteValues

         Hasil copy Value

PasteSpecial Paste:=xlPasteFormulas

        Hasil copy Rumusnya tetap

PasteSpecial Paste:=xlPasteAll

       Hasil copy sama persis dgn aslinya termasuk rumus tetap ada

Selesai
Mari rajin mencoba ,Semakin rajin mencoba maka semakin banyak pengalaman yang kita akan dapat
Semoga bermanfaat

Color Active Cell

         Color active Cell

mewarnai cell aktif tidak terlepas dari kode Warna Properti
yang diaplikasi dengan sebuah nilai
cek pembahasan sebelumnya yakni color indek
Cara  juga hanya perlu membuat sebuah modul
Pastekan kode berikut

Private Sub CommandButton1_Click()
Selection.Cells.Font.ColorIndex = 1  ' 5=Biru
Selection.Cells.Interior.ColorIndex = 8  ' 5=Biru
Unload Me
End Sub

Private Sub CommandButton2_Click()
Selection.Cells.Font.ColorIndex = 2  ' 5=Biru
Selection.Cells.Interior.ColorIndex = 3  ' 5=Biru
Unload Me
End Sub

Selesai
Silahkan dicoba dilembar kerja excel anda

Mewarnai data duplikat

        Mewarnai data duplikat

Materi kali ini kita akan membahas bagaimana menemukan data ganda atau duplikat  ,Hal ini sangat penting bagi seorang operator pengolah data , apalagi jumlah data sampai ruan data sehingga secara manual akan sulit dilakukan
Dengan fasilitas VBA kita akan menemukan dan otomatis menandai data yang dianggap ganda
Carannya cukup mudah dengan membuat Modul
Pastekan kode berikut :

Kode ini mengacu pada data di kolom B

Sub ganda()
Dim LastRow As Long
Dim matchFoundIndex As Long
Dim iCntr As Long
LastRow = Range("b65000").End(xlUp).Row
For iCntr = 2 To LastRow
If Cells(iCntr, 2) <> "" Then
matchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 2), Range("b1:b" & LastRow), 0)
If iCntr <> matchFoundIndex Then
Cells(iCntr, 2).Interior.Color = vbRed
Cells(iCntr, 2).Font.Color = vbWhite
End If
End If
Next
End Sub

Selesai
Semoga Bermanfaat

Copy color Only

       Copy color Only

Copy Color Only adalah menggunakan Kode VBA maksud Copy paste namun hanya warna cell interior saja yang akan dicopy
Adapun isi atau value tidak ikut di copy
Cara  juga hanya perlu membuat sebuah modul
Pastekan kode berikut :

Sub copywarna ()
    Dim cell As Range
    For Each cell In Range("g2:g200")
         Range("a" & cell.Row).Interior.Color = cell.Interior.Color
    Next cell
End Sub

Selesai
Silahkan dicoba dilembar kerja excel anda
Semakin rajin mencoba maka semakin banyak pengalaman yang kita akan dapat
Semoga bermanfaat

Copy UserForm ke Dokumen

Mewarnai UserForm

UserForm Tampil Full

        USERFORM FULL DEKSTOP

Materi  Pembelajaran VBA kali ini adalah bagaimana kita menampilkan sebuah userform tampil full di desktop pada computer anda

Cukup mudah caranya ikuti langkah – langkahnya sebagai berikut :

Pertama kita buka lembar kerja excel  kemudian seperti biasa kita masuk di VBA Property dengan dengan menggunakan tombol pintasan di keyboard anda

ALT + F11

Setelah tampil jendela vba propertinya buatlah

1 buah Userform
1 buah Cammadbuton
          Untuk tombo exit
1 buah label
            Untuk menampilkan tulisan berjalan pada userform

Yang semuanya sudah dibuat dan  dimodif sedemikian rupa sehingga tampil indah sesuai pilihan warna selera anda

Pada userform pastekan kode macro berikut

Dim Berhenti As Boolean
Private Sub UserForm_Initialize()
    With Application
        .WindowState = xlMaximized
        Zoom = Int(.Width / Me.Width * 100)
        Width = .Width
        Height = .Height
    End With
End Sub

Private Sub UserForm_Activate()
    Call Mulai
    End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    Berhenti = True
     If CloseMode = 0 Then
Cancel = True
MsgBox "Untuk  Menutup Form silakan klik tombol Masuk", vbCritical
End If
End Sub

Private Sub Mulai()
    Dim j As Long
   
Awal:
    DoEvents
    If Berhenti = True Then Exit Sub
    Label9.Left = Label9.Left - 2
    If Label9.Left <= -Me.Width Then Label9.Left = Me.Width
      For j = 1 To 6543210: Next
    GoTo Awal
End Sub

Private Sub CommandButton1_Click()
Unload Me
Sheets("Sheet1").Select
End Sub

Pada modul pastekan kode berikut :

Sub fulldekstop()
    Dim xFSO As Object
    Dim xFolder As Object
    Dim xFile As Object
    Dim xFiDialog As FileDialog
    Dim xPath As String
    Dim I As Integer
    Set xFiDialog = Application.FileDialog(msoFileDialogFolderPicker)
    If xFiDialog.Show = -1 Then
        xPath = xFiDialog.SelectedItems(1)
    End If
    Set xFiDialog = Nothing
    If xPath = "" Then Exit Sub
    Set xFSO = CreateObject("Scripting.FileSystemObject")
    Set xFolder = xFSO.GetFolder(xPath)
    For Each xFile In xFolder.Files
        I = I + 1
        ActiveSheet.Hyperlinks.Add Cells(I, 1), xFile.Path, , , xFile.Name
    Next
End Sub

Selesai
Silahkan dipraktekan di lembar kerja anda
Semoga bermanfaat

Dapatkan tutorial lansung belajar vba dari awal sampai mahir melalu kontak dengan buku panduan  Paket Belajar vba lengkap  

PUTU ASANA
Wa . 082 396 256 527

Sampel file Userform full desktop dapat di unduh pada link berikut ini

Membuat Name Range di Lembar Excel

                     Nama Range

Nama range dibuat untuk mengganti penulisan alamat cell

Contoh Alamat cell  Tabel diatas adalah

("b4:e12")

setelah kita buat nama range sesuai yang dikendaki maka kita dapat menulis alamat tarsebut pada penulisan disebuah rumus atau formula

Hal ini sangat membantu dalam mengingat alamat cell saat penulisan pada sebuah Formula sehingga cukup menuliskan nama range yg sdh kita buat sebelumnya

Bandingkan formula dibawah ini

=VLOOKUP(b14,b4:e12,2,FALSE)

=VLOOKUP(b15,data,2,FALSE)


Data pada vlookup diatas sudah mewakili cell b4:e12
Berikut cara membuat nama range sesuai gambar dibawah ini












Selesai
Silahlan dicoba
Semoga bermanfaat

Sum by Color

Menghitung Jumlah cell yang berwarna

Anda pernah mencoba menghitung sel dengan warna di Excel, Anda mungkin telah memperhatikan bahwa Excel tidak mengandung fungsi untuk mencapai ini.
Karena fungsi seperti COUNTIF tidak dapat dihitung berdasarkan warna sel, kita harus membuat fungsi kustom kita sendiri (juga dikenal sebagai Fungsi yang Ditetapkan Pengguna atau UDF) untuk menyelesaikan pekerjaan.
Fungsi Kustom untuk Menghitung Sel dengan Warna
buka Visual Basic Editor dengan menekan Alt + F11 atau dengan mengklik tombol Visual Basic
Buatlah Sebuah Modul dan pastekan Kode berikut

PASTEKAN PADA MODUL
'----------------------------
Function ColorFunction(rColor As Range, rRange As Range, Optional SUM As Boolean)
Dim rCell As Range
Dim lCol As Long
Dim vResult
lCol = rColor.Interior.ColorIndex
If SUM = True Then
For Each rCell In rRange
If rCell.Interior.ColorIndex = lCol Then
vResult = WorksheetFunction.SUM(rCell, vResult)
End If
Next rCell
Else
For Each rCell In rRange
If rCell.Interior.ColorIndex = lCol Then
vResult = 1 + vResult
End If
Next rCell
End If
ColorFunction = vResult
End Function

Kemudian buatlah table seperti gambar diatas dengan  warna cell yang berbeda beda
Kemudian buatlah rumus  di g4

=colorfunction(F4,$B$4:$D$11,FALSE)

Counter

                     Counter

Count  adalah  menghitung sebuah obyek
Obyek yang dimaksud disini adalah berupa baris , kolom ,kolom , sheets, atau rentan nilai dalam sebuah obyek

Misalnya kita akan menghitung jumlah baris yang terisi data tentukan kita akan menggunakan fasilitas VBA

Menghitung jumlah baris yang berisi data di pada sebuah worksheets tertentu Misalnya kita akan menghitung jumlah data lembar kerja aktif.
Ini kode nya :

Sub test()
    Dim myRange As Range
    Dim NumRows As Integer
    Set myRange = Range("A:A")
    NumRows = Application.WorksheetFunction.CountA(myRange)
    MsgBox NumRows
End Sub

Kita mencoba menghitung jumlah baris dalam rentang dalam lembar kerja yang berbeda dari lembar kerja aktif. Ini kode nya :

Sub data()
Dim jumlahdata As Long
With Sheets("data")
jumlahdata = .Range("A" & .Rows.Count).End(xlUp).Row
End With
MsgBox (jumlahdata)
End Sub

Menghitung jumlah sheet yang ada di workbook

Sub Count_sheet()
myCount = Application.Sheets.Count
    MsgBox myCount
    End Sub
   
Menghitung jumlah baris selection

Sub Count_Rows()
    myCount = Selection.Rows.Count
  MsgBox myCount
    End Sub

Menghitung jumlah kolom selection

Sub Count_Coulumn()
    myCount = Selection.Columns.Count
    MsgBox myCount
    End Sub

         
Sub Count_nilai()
  menambah nilai di cell A1 Setiap kali macro running
          mycount = Range("a1") + 1
            Range("a1") = mycount
            End Sub

Selesai
silahkan dikembangkan selanjutnya
Semoga bermanfaat

DIM Statemem - excel Vba

               STATEMEN DIM

                 Pengertian DIM

DIM adalah bagian dari versi awal bahasa komputer BASIC (Beginner's All Purpose Symbolic Instruction Code) yang dikembangkan oleh dua matematikawan, John George Kemeny dan Tom Kurtzasat Dartmouth College, pada tahun 1964.

FUNGSI  DIM

FUNGSI  DIM  adalah Untuk mendeklarasikan banyak jenis variabel dalam BASIC atau VBA  ,Termasuk seluruh bilangan (byte, integer atau panjang), bilangan floating-point (tunggal atau ganda), string (alfanumerik), mata uang, tanggal, Boolean dan objek.

Asal Mula DIM

DIM awalnya berdiri untuk "Dimensi" mengacu pada ukuran array (matriks variabel) atau jenis variabel yang digunakan. Lebih umum, programmer mengacu pada DIM sebagai "menyatakan" jenis variabel.
DIM  sangat pentingnya dalam versi Visual Basic, termasuk VBA di Excel
jika jenis variabel tidak dideklarasikan, default ke tipe "varian". maka
ketika kode dijalankan, jika program harus menentukan  jenis variabelnya, bila tdk ini akan  memperlambat kerja  aplikasi.

Syarat penting dalam penggunaan DIM adalah

1.Menempatkan kata-kata "Option Explicit" (tanpa tanda kutip) pada awal modul kode di VBA di Excel akan menjebak setiap upaya penggunaan variabel yang tidak dideklarasikan. Ini akan mencegah masalah nanti .

Menggunakan statement Dim sesuai type datanya
1.Type data text

Dim passpor As String
Dim Nama As String

2.Type data angka

Dim firstnum As Integer
Dim secondnum As Integer
Dim total As Integer

3.Type data tingkat

Dim Nomor As Long,
Dim Baris As Long

4.Type data tanggal

Dim BirthDay As Date
Dim Lahir As Date

5.Type data Mata uang

Dim Income As Currency
Dim gaji As Currency

Contoh Penggunaan Dim
Contoh1

Sub name ()
Dim YourName As String
Dim BirthDay As Date
Dim Income As Currency
YourName = "Alex"
BirthDay = "1 April 1980"
Income = 1000
Range("b1") = YourName
Range("b2") = BirthDay
Range("c3") = Income
End Sub

Contoh2
  
Sub Nomor_urut()
Dim Nomor As Long,
Dim Baris As Long
lNomor = 1
For lBaris = 1 To 5 Step 1
Sheets("Dataku").Range("A" & lBaris).Value = lNomor
lNomor = lNomor + 1
Next lBaris
End Sub
                                                             
Selesai
Semoga bermanfaat

Option Explicit

                Option explicit
Biasanya option explicit diletakan di bagian atas coding atau dibagian general.

Fungsi option explicit untuk memaksa programmer mendeklarasikan semua variabel sebelum variabel tersebut digunakan. dengan option explicit akan sangat membantu programmer dalam mengurangi kesalahan dan mengetahui letak kesalahan atau debug.

Contoh Penulisan kode yang salah

Option Explicit
Sub test()
Dim myVar As Integer
myVar = 10
Range("A3 : A10").Value = mVar
End Sub

Option Explicit
Private Sub CommandButton1_Click()
Dim score As Integer, result As String
score = Range("A3 : A10").Value
If scor >= 60 Then result = "pass"
Range("B1").Value = result
End Sub

Option Explicit
Sub cek_error()
Dim YourName As String, password As String
YourName = "John"
password = 12345
Cells(1, 2) = YourNam
Cells(1, 3) = password
End Sub

Selesai

Silahkan dicoba atau dipraktekkan langsung dilembar kerja excel
Semoga bermanfaat

Formating Cell VBA

                  Format Cell

Format Cell pada pasiliatas VBA dapat anda gunakan dalam penulisan di sebuah Modul yang menjadikan alamat cell di lembar excel sebagai target acuan
Berikut Macam – macam  format yang perlu di ketahui antara lain :

1.General

Range("A3 : A10").NumberFormat = "General"

2.NumberFormat           : Format Angka

Range("A3 : A10").NumberFormat = "0000000000"  

3.Currency Mata Uang

Range("A3 : A10").NumberFormat = "$#,##0.00"

4.Accounting

Range("A3 : A10").NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"

5.Date atau Tanggal

Range("A3 : A10").NumberFormat = "yyyy-mm-dd;@"
Range("A3 : A10").NumberFormat = "dd/mm/yyyy"                                                        
Range("A3 : A10").NumberFormat = "[$-421]dd mmmm yyyy"   

6.Time atau menit

Range("A3 : A10").NumberFormat = "h:mm:ss AM/PM;@"

7.Percentase %

Range("A3 : A10").NumberFormat = "0.00%"

8.Fraction

Range("A3 : A10").NumberFormat = "# ?/?"

9.Scientific

Range("A3 : A10").NumberFormat = "0.00E+00"

10.Text atau Hurup

Range("A3 : A10").NumberFormat = "@"

11.Special

Range("A3 : A10").NumberFormat = "00000"

12.Custom

Range("A3 : A10").NumberFormat ="$#,##0.00_);[Red]($#,##0.00)"

Contoh Penulisan1

Sub pengatuaranCell ()
Sheets("Sheet1"). Range("A3 : A10").NumberFormat = "00000"
End Sub
Contoh Penulisan2

Sub Atur_format()
With Sheets("Sheet1")
.Range("A3 : A10").NumberFormat = "000"
.Range("B3 : B10").NumberFormat = "yyyy-mm-dd;@"
.Range("C3 : C10").NumberFormat = "dd/mm/yyyy"
.Range("D3 : D10").NumberFormat = "[$-421]dd mmmm yyyy"
.Range("E3 : E10").NumberFormat = "$#,##0.00"
End With
End Sub

Selesai
Silahkan dicoba atau dipraktekkan langsung dilembar kerja excel
Semoga bermanfaat

Selection Cell

Selection Select 

Bergeser satu cell ke kanan
ActiveCell.Offset(0, 1).Select    ’

Menuju ke cell paling bawah yang terahir di Isi
ActiveCell.End(xlDown).Select‘

Pindah ke cell yang di bawahnya satu baris
ActiveCell.Offset(1, 0).Select  ’

mengisi cell A1 dengan konten “Hello”
Worksheets(“Sheet1”).Range(“A1”).Value = “Hello”

Mengisi cell yang aktif sesuai dengan kata yang di ketik di
textbox1ActiveCell.Value= TextBox1.Text  ’

Mengisi cell tertentu via input box shg user diminta isi user box dulu kemudian otomatis cell tertentu akan terisi sesuai isian input box
Range (“a1”).value = Inputbox (“pertanyaan”)

Memanggil sheet sesuai dengan urutannya
sheet2.select

Memanggil sheet sesuai dengan nama sheet nya
sheet(“databased”).select

Menuju baris terakhir
BarisTerakhir = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Value

cari baris kosong pertama di database
iRow =ws.Cells(Rows.Count, 1)  _
.End(xlUp).Offset(1, 0).Row

Menuju ke alamat cell spesial paling awal/atas dan ujung bawah/terakhir sheet
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select

Menuju ke alamat cell paling ujung bawah/terakhir
sheetActiveCell.SpecialCells(xlLastCell).Select

Menuju ke alamat cell paling atas, bawah, kiri, kanan
Selection.End(xlUp).Select      ‘atas
Selection.End(xlDown).Select     ‘bawah
Selection.End(xlToLeft).Select      ‘kiri
Selection.End(xlToRight).Select     ‘kanan

Dari tempat cell berada sekarang diblok sampai ke alamat cell paling atas, bawah, kiri, kanan

Range(Selection,Selection.End(xlUp)).Select
Range(Selection,Selection.End(xlDown)).Select
Range(Selection,Selection.End(xlToLeft)).Select
Range(Selection,Selection.End(xlToRight)).Select

menuju ke cell turun 5 baris dan kekiri 3 kolom, dari tempat cell berada sekarang
ActiveCell.Offset(5, -3).Select

menuju ke cell naik 3 baris dan kekanan 4 kolom, dari tempat cell berada sekarang
ActiveCell.Offset(-3, 4).Select

memilih range / blok tertentu dan melanjutkan atau menambah range / blok dari blok yang sudah ada
Range(“Database”).Select
Selection.Resize(Selection.Rows.Count+ 5, _
Selection.Columns.Count).Select

memilih range / blok tertentu kemudian melompat ke cell tertentu dan melanjutkan atau menambah range / blok yang sudah ada
Range(“Database”).Select
Selection.Offset(4, 3).Resize(Selection.Rows.Count+ 2, _
Selection.Columns.Count+ 1).Select

Menandai Data Ganda

        Menandai Data Ganda

Pembahasaan saat ini adalah mencari dan menemukan data ganda atau data duplikat . Model pencarian ini sangat bermanfaat apabila kita dihadapkan oleh Ratusan data bahkan Ribuan data  untuk dapat menemukan data ganda misalnya data pemilih ganda
dengan Bantuan Visual Basic Kita akan dapat menemukan dgn mudah bahkan dalam waktu 1 menit kita dapat mengatasi ribuuan data menemukan dan menandainya

Cukup Mudah  caranya Pastekan kode berikut pada Sebuah Modul
Yang mengacu pada kolom b  baris ke 2

LastRow = Range("b65000").End(xlUp).Row
For iCntr = 2 To LastRow

Kode lengkapnya :

Sub Tampilkan()
Dim LastRow As Long
Dim matchFoundIndex As Long
Dim iCntr As Long
LastRow = Range("b65000").End(xlUp).Row
For iCntr = 2 To LastRow
If Cells(iCntr, 2) <> "" Then
matchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 2), Range("b1:b" & LastRow), 0)
If iCntr <> matchFoundIndex Then
Cells(iCntr, 2).Interior.Color = vbRed
Cells(iCntr, 2).Font.Color = vbWhite
End If
End If
Next
End Sub

Selesai
Semoga bermanfaat
Silahkan klik halaman Download dibawah ini


 Data Ganda