Minggu, 05 April 2015

Active cell Selection

'Menyorot baris dan kolom pada cell aktif dengan warna
Sub activecell_seleksi
 Dim RngRow          As Range
    Dim RngCol          As Range
    Dim RngFinal        As Range
    Dim Row             As Long
    Dim Col             As Long
   
    Cells.Interior.ColorIndex = xlNone
    'Range(ActiveCell, ActiveCell.End(xlDown)).Select
   
    'Row = Target.Row
    Row = Target.Row
    Col = Target.Column
   
    Set RngRow = Range("A" & Row, Target.End(xlToRight))
    Set RngCol = Range(Cells(1, Col), Target)
    Set RngFinal = Union(RngRow, RngCol)
   
    RngFinal.Interior.ColorIndex = 6

End Sub

VLOOKUP VBA lanjutan

'VLOOKUP lanjutan
Sub ADDCLM()
On Error Resume Next
Dim Dept_Row As Long
Dim Dept_Clm As Long
Table1 = Sheet2.Range("d5:d17") ' Employee_ID Column from Employee table yang dcari
Table2 = Sheet2.Range("k5:l17") ' Range of Employee Table 1 tabel yang dijadikan referensi
Dept_Row = Sheet1.Range("g5").Row ' Change E3 with the cell from where you need to start populating the Department
Dept_Clm = Sheet1.Range("g3").Column
For Each cl In Table1
  Sheet2.Cells(Dept_Row, Dept_Clm) = Application.WorksheetFunction.VLookup(cl, Table2, 2, False)
  Dept_Row = Dept_Row + 1
Next cl
MsgBox "Done"
End Sub

VBA VLOOKUP

'vlookup dengan input box
Sub FINDSAL()
On Error GoTo MyErrorHandler:
Dim E_name As String
E_name = InputBox("Enter the Sales person Name :")
If Len(E_name) > 0 Then
  Sal = Application.WorksheetFunction.VLookup(E_name, Sheet1.Range("B5:E17"), 3, False)
  MsgBox "Net sales is : $ " & Sal
Else
  MsgBox ("You entered an invalid value")
End If
Exit Sub
MyErrorHandler:
If Err.Number = 1004 Then
  MsgBox "Employee Not Present in the table."
End If
End Sub