VBA Scripting Dictionary Vlookup help please

jvalente · Feb 3rd 2017

Hi All,

I am having trouble with some code I've started writing.

I have two lists, both with references. I basically want to vlookup from one sheet (complete list) to the other sheet (incomplete list). Whatever isn't found in the incomplete list, add from the complete list.

Only add what's missing not everything! (What my code does - a combination of the missing and incomplete)

What I am getting is instead of the dictionary writing out just the new references I have to add to the incomplete list, it's adding both the elements together in the dictionary (what the final result will be).

I'll repeat it again, hard to explain I guess.

I don't want my dictionary to return the complete list, only the new items I need to add.

Hope that makes sense.

Code

Sub GetMissingCBSSIDs()


Dim i As Long
Dim AppsAmt As Double
Dim CBSSID As String
Dim Sh As Worksheet
Dim Sh2 As Worksheet
Dim RGMatches As Range
Dim Lastrow As Long
Dim IDBroker As Variant
Dim NewIDBroker As Variant


' Create dictonary


Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
    
' Get worksheet


Set Sh = ThisWorkbook.Worksheets("Association Table")
Set Sh2 = ThisWorkbook.Sheets("Test")


' Vlookup Using Scripting Dictionary


Lastrow = Sh.Range("A" & Rows.Count).End(xlUp).Row


dict.RemoveAll ' clear the dictionary
                                                    
' Looping to store values in dictionary


NewIDBroker = Sh.Range("a1").CurrentRegion.Value 'load our values from Test
        
For i = 2 To Lastrow
    
    dict.Item(NewIDBroker(i, 1)) = NewIDBroker(i, 1)


Next i


'Looping to compare


IDBroker = Sh2.Range("a1").CurrentRegion.Value


Lastrow = Sh2.Range("A" & Rows.Count).End(xlUp).Row


For i = 2 To Lastrow


    If dict.exists(IDBroker(i, 1)) Then ' we found the item
    
              IDBroker(i, 1) = "not new"
  
        Else:
              IDBroker(i, 1) = dict.Item(IDBroker(i, 1)) ' not found
   
    End If


Next i


'Dim key As Variant
'For Each key In dict.keys
'    Debug.Print key
'Next key


'Print the values to sheet


Dim lrow As Long, k As Variant


lrow = 2
For Each IDBroker In dict.keys
        Sheets("test").Cells(lrow, 4) = IDBroker
        Sheets("test").Cells(lrow, 5) = dict(IDBroker)
        lrow = lrow + 1
Next
    
End Sub

Display More

richadj4 · Feb 3rd 2017

Re: VBA Scripting Dictionary Vlookup help please

I've looked at this about 5 times, procrastinating in the hopes someone else will come solve but, but I guess I'll give it a go.

1) Okay, you start by looping through sh and adding each entry to a dictionary. As both an item and a key (why?????) FYI this

Code

dict.Item(NewIDBroker(i, 1)) = NewIDBroker(i, 1)

is REALLY bad practice.

2) you then loop through each line in sh2 and check to see if it's in the dictionary. If it IS, then you overwrite it with "not new" (not sure why, but okay), if it isn't then you...... overwrite it with itself (whhhhhhy)

3) Finally you then loop through the dictionary and output everything to sh2 again. You haven't at any point removed anything from the dictionary because it was already in there.

I...... really hope I'm missing something obvious.

jvalente · Feb 3rd 2017

Re: VBA Scripting Dictionary Vlookup help please

Thanks for your comments. I'm still learning this type of code. I'll get back to reading online material.
Have a good day

**StephenR** · Feb 3rd 2017

Re: VBA Scripting Dictionary Vlookup help please

Not really clear why you are using a dictionary. I suggest you post a small sample workbook.

jvalente · Feb 6th 2017

Re: VBA Scripting Dictionary Vlookup help please

Hi All,

I've figure it out.

StephenR, I want to use a dictionary because I'm doing this over thousands of records and using other methods tends to be slow.

I'll try re-iterating my problem:

I have a list 'association table' with a list of references and then I have another list of references ('test').

Whatever I don't find from association table in 'test' add to the bottom of test.

Code

Sub GetMissingCBSSIDs()


Dim i As Long
Dim AppsAmt As Double
Dim CBSSID As String
Dim Sh As Worksheet
Dim Sh2 As Worksheet
Dim RGMatches As Range
Dim Lastrow As Long
Dim IDBroker As Variant
Dim NewIDBroker As Variant


' Create dictonary


Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
    
' Get worksheet


Set Sh = ThisWorkbook.Worksheets("Association Table")
Set Sh2 = ThisWorkbook.Sheets("Test")


' Vlookup Using Scripting Dictionary


Lastrow = Sh.Range("A" & Rows.Count).End(xlUp).Row


dict.RemoveAll ' clear the dictionary
                                                    
' Looping to store values in dictionary


NewIDBroker = Sh.Range("a1").CurrentRegion.Value 'load our values from Test
        
For i = 2 To Lastrow


    dict.Add key:=NewIDBroker(i, 1), Item:=NewIDBroker(i, 1)


Next i


'Looping to compare


IDBroker = Sh2.Range("a1").CurrentRegion.Value


Lastrow = Sh2.Range("A" & Rows.Count).End(xlUp).Row


For i = 2 To Lastrow


    If dict.exists(IDBroker(i, 1)) Then ' we found the item
    
        dict.Remove (IDBroker(i, 1)) ' I don't want this added to my items (I only want to capture the new data that I need to add to my other list)
  
        Else:
              
              IDBroker(i, 1) = dict.Item(IDBroker(i, 1)) ' not found add this value to my items
            
    End If


Next i


'Dim key As Variant
'For Each key In dict.keys
'    Debug.Print key, dict(key)
'Next key


'Print the values to sheet


Dim lrow As Long, k As Variant


lrow = Sh2.Range("A" & Rows.Count).End(xlUp).Row + 1


For Each IDBroker In dict.keys
       Sh2.Range("A" & lrow) = dict(IDBroker) ' add to bottom of original list
        lrow = lrow + 1
Next
    
End Sub

Display More

The solution was to remove common identifiers between both lists and leave only unique items to both lists

Code

dict.exists(IDBroker(i, 1)) Then ' we found the item
    
        dict.Remove (IDBroker(i, 1)) ' I don't want this added to my  items (I only want to capture the new data that I need to add to my  other list)

VBA Scripting Dictionary Vlookup help please

Participate now!

Share