Excel Vba using Scripting Dictionary to add Missing Job Numbers

[Biz]

Dear All,

I tried using method below but it does not

[COLOR=#1f497d][COLOR=black]aDestinationArray(u) = aDict(aResultArray(aRowCount, 1)) -[FONT=Wingdings]à[/FONT] It does not passes value at all<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /><o:p></o:p>[/COLOR]
[/COLOR]

<o></o>
Other way which works<o></o>

aDestinationArray(u) = aResultArray(aRowCount, 1)<o:p></o:p>

<o></o>

How can I fix so that I can use aDict?<o></o>
<o></o>
Vba works but no using Dictionary. Full code is listed below.
<o></o>

Sub FasterWay(myVRng As Range, tRange As Range)
    Dim aDict As Object, aDataArray(), aResultArray(), aDestinationArray(), NewArray(), aRowCount As Long, au As Long
    Dim j As Long, u As Long, y As Long
    Dim newJGLCode As Range, R As Range
 
    Set newJGLCode = Sheets("Forecast").Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
 
    aDataArray = Sheets(tRange.Parent.Name).Range(tRange.Address).Value 'Check add new items tRange.Address
    Set aDict = CreateObject("Scripting.Dictionary")
    For aRowCount = 1 To UBound(aDataArray, 1)
        aDict(aDataArray(aRowCount, 1)) = aDataArray(aRowCount, 1)
    Next aRowCount
    aResultArray = Sheets(myVRng.Parent.Name).Range(myVRng.Address).Value 'Full List <=====
 
    ReDim aDestinationArray(1 To UBound(aResultArray))
    u = 1
    For aRowCount = 2 To UBound(aResultArray, 1)
        If Not aDict.Exists(aResultArray(aRowCount, 1)) Then    'If key exists
        'aResultArray(aRowCount, 1) = aDict(aResultArray(aRowCount, 1)) 'Get row of data from dictionary
        'aDestinationArray(u) = aDict(aResultArray(aRowCount, 1))
        aDestinationArray(u) = aResultArray(aRowCount, 1)
        u = u + 1
    End If
Next aRowCount
'Remove Empty values
ReDim NewArray(LBound(aDestinationArray) To UBound(aDestinationArray))
For y = LBound(aDestinationArray) To UBound(aDestinationArray)
    If aDestinationArray(y) <> "" Then
        j = j + 1
        NewArray(j) = aDestinationArray(y)
    End If
Next y
ReDim Preserve NewArray(LBound(aDestinationArray) To j)
' put the array values on the worksheet
Set R = newJGLCode.Resize(j - LBound(NewArray) + 1)
R.Value = Application.Transpose(NewArray)
'Release memory
    Set R = Nothing
 
'Erase Arrays
Erase aDataArray
Erase aResultArray
Erase aDestinationArray
Erase NewArray
End Sub

Your help would be greatly appreciated.

Biz

 

[AlphaFrog]

It looks like you are trying to read a value from the dictionary that does not exist.

        [color=darkblue]If[/color] [color=red]Not[/color] aDict.Exists(aResultArray(aRowCount, 1)) [color=darkblue]Then[/color]    [color=green]'If key exists[/color]
        [color=green]'aResultArray(aRowCount, 1) = aDict(aResultArray(aRowCount, 1)) 'Get row of data from dictionary[/color]
        aDestinationArray(u) = aDict(aResultArray(aRowCount, 1))

 

[Biz]

Hi AlphaFrog,

You are right. I am trying use dictionary to add items in Forecast Tab then compare it with Job Codes and if it does not exist then add it Forecast tab.

Probably my approach is wrong. Can you think of better way using Dictionary?

Biz