Revision: 61671
Updated Code
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
Initial Code
Initial URL
Initial Description
Initial Title
Initial Tags
Initial Language
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