Posted By

lolrenx on 01/04/13

Tagged

excel dictionary vba

Versions (?)

Dictionary loader

/ Published in: Visual Basic

short loop to load a dictionary

Highlighted TextExpand

Public Sub Load_CC_Dico(tgtDico As Dictionary, tgtSht As Worksheet, _
KeyStr As String, H1 As String, Optional H2 As String, Optional H3 As String, _
Optional H4 As String, Optional H5 As String)

Dim KeyCol As Long, ColH1 As Long, ColH2 As Long, ColH3 As Long, ColH4 As Long, ColH5 As Long
Dim TempArr As Variant: TempArr = Omit_Header(tgtSht.UsedRange).Value
KeyCol = MatchCol(KeyStr, tgtSht.Rows(1))
ColH1 = MatchCol(H1, tgtSht.Rows(1))
If Len(H2) > 0 Then ColH2 = MatchCol(H2, tgtSht.Rows(1))
If Len(H3) > 0 Then ColH3 = MatchCol(H3, tgtSht.Rows(1))
If Len(H4) > 0 Then ColH4 = MatchCol(H4, tgtSht.Rows(1))
If Len(H5) > 0 Then ColH5 = MatchCol(H5, tgtSht.Rows(1))

Dim Temp_Dico As Dictionary

Dim i As Long
For i = LBound(TempArr, 1) To UBound(TempArr, 1)
    Application.StatusBar = "Loading  Dictionary, " & Calc_Advance(i, UBound(TempArr, 1)) & " % done"
    If Not tgtDico.Exists(TempArr(i, KeyCol)) Then
        Set Temp_Dico = New Dictionary
            With Temp_Dico
                .Add H1, TempArr(i, ColH1)
                If Len(H2) > 0 Then .Add H2, TempArr(i, ColH2)
                If Len(H3) > 0 Then .Add H3, TempArr(i, ColH3)
                If Len(H4) > 0 Then .Add H4, TempArr(i, ColH4)
                If Len(H5) > 0 Then .Add H5, TempArr(i, ColH5)
            End With
        tgtDico.Add TempArr(i, KeyCol), Temp_Dico
        Set Temp_Dico = Nothing
    End If
Next i

Application.StatusBar = False
Set Temp_Dico = Nothing

Exit Sub

ErrFound:

MsgBox ("Error")

Resume

End Sub

Report this snippet Tweet

Comment:

You need to login to post a comment.

Posted By

Tagged

Versions (?)

Dictionary loader

Related snippets

Choose a language for easy browsing: