Excel VBA 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.
Code:
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
