Return to Snippet

Revision: 61671
at January 4, 2013 20:06 by lolrenx


Updated Code
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

Revision: 61670
at January 4, 2013 20:05 by lolrenx


Initial Code
Option Explicit
Private Const SearchGPNCol      As String = "BOOKSTORE_DESK_OWNER_GPN"

Private Const CostCenter        As String = "COST_CENTRE"
Private Const BRegion           As String = "BUSINESS_REGION"
Private Const BArea             As String = "BUSINESS_AREA_NAME"
Private Const BSector           As String = "BUSINESS_SECTOR_NAME"
Private Const BSegment          As String = "BUSINESS_SEGMENT_NAME"
Private Const BFunction         As String = "BUSINESS_FUNCTION_NAME"

Sub Load_Cost_Center_to_Dictionary(tgtDico As Dictionary, CCMapping As Worksheet)

Set tgtDico = New Dictionary

Call Load_CC_Dico(tgtDico, CCMapping, CostCenter, BRegion, BArea, BSector, BSegment, BFunction)

Dim myArray As Variant, Emp_Dico As Dictionary

End Sub

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

Initial URL

                                

Initial Description
short loop to load a dictionary

Initial Title
Dictionary loader

Initial Tags
excel

Initial Language
Visual Basic