Dictionary Object :

when playing with data many times we needs to save some unique values somewhere, that time we can use dictionary object , it does not allow to store duplicate values in it, 

Dictionary object Takes two argument at the time of adding data 1) Key .2 ) Value and it returns the value by  ID, so when we need to retrieve any values just we need to give ID number , A very good example is given here to understand Dictionary object :

                      This procedure bifurcate data from one worksheet to multiple worksheets based on multiple values exist in Column "B" on Sheet1 , first it stores all the unique from B column in dictionary and then start bifurcating data.

Sub DistributeDataOnSheets()
    Set objDic = CreateObject("Scripting.Dictionary")
        If Not objDic.Exists(VarFilterData(lngLoop)) Then objDic.Add VarFilterData(lngLoop), VarFilterData(lngLoop)

    Dim VarFilterData()

    Dim objDic As Object

    Dim wksSheet As Worksheet

    Dim lngLoop As Long

    Dim rngRange As Range

    Dim wkSSheetNew As Worksheet

   

    Set wksSheet = ThisWorkbook.Worksheets("Sheet1")

    VarFilterData = Application.Transpose(Intersect(wksSheet.UsedRange, wksSheet.UsedRange.Columns(2).Offset(1)))

   

    For lngLoop = LBound(VarFilterData) To UBound(VarFilterData)

    Next lngLoop

    Application.ScreenUpdating = False

    For lngLoop = 1 To objDic.Count

        With wksSheet.UsedRange.Columns(2)

            .Replace VarFilterData(lngLoop), ""

            Set rngRange = .SpecialCells(xlCellTypeBlanks)

            rngRange.Value = VarFilterData(lngLoop)

        End With

        Application.DisplayAlerts = False

        On Error Resume Next

            ThisWorkbook.Worksheets(VarFilterData(lngLoop)).Delete

        On Error GoTo 0: On Error GoTo -1

        Application.DisplayAlerts = True

        Set wkSSheetNew = ThisWorkbook.Worksheets.Add

        wkSSheetNew.Name = VarFilterData(lngLoop)

        wksSheet.Rows(1).Copy wkSSheetNew.Range("A1")

        rngRange.EntireRow.Copy wkSSheetNew.Range("A2")

    Next lngLoop

   

    Application.ScreenUpdating = True

    MsgBox "Done"

End Sub

Hope you will like it