Results 1 to 2 of 2

Thread: Excel VBA Dictionary Object

  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

  2. #2
    Junior Member
    Join Date
    May 2012
    Posts
    25
    Rep Power
    0
    hi Rajan,

    this is nice!

    However, it would really help if you could provide a sample file for this code in order to understand.


    https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
    https://www.youtube.com/watch?v=jTmVtPHtiTg&lc=Ugy_RiNN_kAqUvZ8W994AaABAg
    https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgNsaS3Lp1
    https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgR1EPUkhw
    https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgNe_XC-jK
    https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgNPOdiDuv
    https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgN7AC7wAc
    https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgyBACXgNY4j_cHgH5J4AaABAg.9oTkVdzfqfm 9wlhQrYJP3M
    https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgxYgiEZuS9I3xkjJv54AaABAg
    https://www.youtube.com/watch?v=DVFFApHzYVk&lc=Ugyi578yhj9zShmhuPl4AaABAg
    https://www.youtube.com/watch?v=GqzeFYWjTxI&lc=UgxvxlnuTRWiV6MUZB14AaABAg
    https://www.youtube.com/watch?v=_8i1fVEi5WY&lc=Ugz0ptwE5J-2CpX4Lzh4AaABAg
    https://www.youtube.com/watch?v=0ltJS7uHfK4&lc=UgxoHAw8RwR7VmyVBUt4AaABAg. 9C-br0lEl8V9xI0_6pCaR9
    https://www.youtube.com/watch?v=0ltJS7uHfK4&lc=Ugz5DDCMqmHLeEjUU8t4AaABAg. 9bl7m03Onql9xI-ar3Z0ME
    https://www.youtube.com/watch?v=0ltJS7uHfK4&lc=UgxYnpd9leriPmc8rPd4AaABAg. 9gdrYDocLIm9xI-2ZpVF-q
    https://www.youtube.com/watch?v=0ltJS7uHfK4&lc=UgyjoPLjNeIAOMVH_u94AaABAg. 9id_Q3FO8Lp9xHyeYSuv1I
    https://www.reddit.com/r/windowsxp/comments/pexq9q/comment/k81ybvj/?utm_source=reddit&utm_medium=web2x&context=3
    https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgxYgiEZuS9I3xkjJv54AaABAg
    https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgyBACXgNY4j_cHgH5J4AaABAg.9oTkVdzfqfm 9wlhQrYJP3M
    ttps://www.youtube.com/watch?v=LP9fz2DCMBE
    https://www.youtube.com/watch?v=LP9fz2DCMBE&lc=UgzbPgJUMCztIOQDym14AaABAg
    https://www.youtube.com/watch?v=LP9fz2DCMBE&lc=UgzbPgJUMCztIOQDym14AaABAg. 9wdo_rWgxSH9wdpcYqrvp8
    ttps://www.youtube.com/watch?v=bFxnXH4-L1A
    https://www.youtube.com/watch?v=bFxnXH4-L1A&lc=UgxuODisjo6cvom7O-B4AaABAg.9w_AeS3JiK09wdi2XviwLG
    https://www.youtube.com/watch?v=bFxnXH4-L1A&lc=UgxBU39bTptFznDC1PJ4AaABAg
    ttps://www.youtube.com/watch?v=GqzeFYWjTxI
    https://www.youtube.com/watch?v=GqzeFYWjTxI&lc=UgwJnJDJ5JT8hFvibt14AaABAg
    https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
    Last edited by DocAElstein; 11-30-2023 at 03:08 PM.

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
  •