Results 1 to 2 of 2

Thread: Excel VBA Dictionary Object

Threaded View

Previous Post Previous Post   Next Post Next Post
  1. #1
    Member Rajan_Verma's Avatar
    Join Date
    Sep 2011
    Posts
    81
    Rep Power
    14

    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
    Last edited by Rajan_Verma; 03-17-2017 at 05:16 PM. Reason: Syntax Error

Similar Threads

  1. Free memory from object using copymemory Api function
    By Kamil Zien in forum Excel Help
    Replies: 0
    Last Post: 05-29-2013, 12:51 PM
  2. Vba scripting dictionary help
    By bpascal123 in forum Excel Help
    Replies: 1
    Last Post: 07-14-2012, 10:52 AM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •