REMOVE BLANK CELL AND FILTER LIST DUPLIKAT- EXCEL VBA

Sub RemoveBlankCells()

Dim rng As Range

On Error GoTo NoBlanksFound

  [b2:b20].Copy ActiveSheet.[c2]

    Set rng = Range("c2:c20").SpecialCells(xlCellTypeBlanks)

  On Error GoTo 0

 rng.Rows.Delete Shift:=xlShiftUp

Exit Sub

NoBlanksFound:

  MsgBox "Tidak ada Cell Kosong"

End Sub

Sub buat_list_hapus_duplikat()
Dim x As Range
With CreateObject("scripting.dictionary")
 For Each x In [b3:b20]
  .Item(x.Value) = ""
Next x
[c3].Resize(.Count) = Application.Transpose(.keys)
End With

Dim rng As Range

On Error GoTo NoBlanksFound

    Set rng = Range("c3:c20").SpecialCells(xlCellTypeBlanks)

  On Error GoTo 0

 rng.Rows.Delete Shift:=xlShiftUp

Exit Sub

NoBlanksFound:

  MsgBox "Tidak ada Cell Kosong"
End Sub

'Pastekan Kode Pada Worksheet

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

'Hapus Duplicate

[D2].Formula = "=B2"

 [D3:D100].Formula = "=IF(COUNTIF(B2:B3,B3)=2,0,IF(COUNTIF(B3:B3,B3)=1,B3,0))"

'No Urut berdasarkan data D

[C2:C30].Formula = "=IF(C2<>0,COUNTA($C$2:C2),0)"

End Sub

Demikian silahkan dikembangkan lagi 
dan Semoga bermanfaat !!!

dapatkan Aplikasi - aplikasi Gratis pada link dibawah ini
  
Link Konten Blog