Excel VBA Dictionary Object

[Rajan_Verma]

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()

    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)))
    Set objDic = CreateObject("Scripting.Dictionary")
    
    For lngLoop = LBound(VarFilterData) To UBound(VarFilterData)
         If Not objDic.Exists(VarFilterData(lngLoop)) Then objDic.Add VarFilterData(lngLoop), VarFilterData(lngLoop)   
    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",vbInformation
End Sub

Hope you will like it