Run time Error 13

[timmytonga]

Hi,

Vlookups were taking forever so I wrote the below code to use the scripting dictionary. It works fine on smaller amounts of data but I am getting the Run time error on my "live run". I assume it is due to the size of my data. how can I fix this. My work sheets are between 250k and 350k+ rows

I noted where the error happens. hovering over "vlookuptable" 3 lines above the error I can tell it is a memory issue.
Not quite sure how to run the code so that it would loop at say 50,000 line increments


Please and thank you

Module

---

[INDENT=2]Public LookupFromwb As String
Public ReturnTowb As String


Sub FAST_VLOOKUP()




Dim dicLookupTable As Scripting.Dictionary
Dim i As Long
Dim sKey As String
Dim vLookupValues As Variant
Dim vLookupTable As Variant


Set dicLookupTable = New Scripting.Dictionary
dicLookupTable.CompareMode = vbTextCompare






WBsel.Show






Dim myRefValues As Range
Dim myResults As Range
Dim MyLookValues As Range
Dim MyresultValues As Range




Workbooks(ReturnTowb).Activate
Set myRefValues = Application.InputBox("Please select the first cell in the column with the reference values that are using for the lookup.", Type:=8)
    Dim MRV As String
    MRV = myRefValues.Parent.Name
    Workbooks(ReturnTowb).Worksheets(MRV).Activate
Set myResults = Application.InputBox("Please select the first cell where you want your lookup results to start ", Type:=8)
    Dim MR As String
    MR = myResults.Address(External:=False)








Workbooks(LookupFromwb).Activate
Set MyLookValues = Application.InputBox("Please select the first cell where your reference values start ", Type:=8)
    Dim MLV As String
    MLV = MyLookValues.Parent.Name
    Workbooks(LookupFromwb).Worksheets(MLV).Activate
Set MyresultValues = Application.InputBox("Please select the first cell where the values we are returning start ", Type:=8)






Dim finalrow As Long
[/INDENT]
[INDENT=2]Dim finalrow2 As Long[/INDENT]
[INDENT=2]Dim Cntr As Integer[/INDENT]
[INDENT=2]
[/INDENT]
[INDENT=2]
[/INDENT]
[INDENT=2] Cntr = (MyresultValues.Column - MyLookValues.Column + 1)[/INDENT]
[INDENT=2]
[/INDENT]
[INDENT=2]Workbooks(LookupFromwb).Activate[/INDENT]
[INDENT=2]
[/INDENT]
[INDENT=2]With Worksheets(MLV)[/INDENT]
[INDENT=2]    finalrow = MyLookValues.SpecialCells(xlCellTypeLastCell).Row[/INDENT]
[INDENT=2]   vLookupTable = .Range(.Cells(MyLookValues.Row, MyLookValues.Column), .Cells(finalrow, MyresultValues.Column))[/INDENT]
[INDENT=2]   For i = LBound(vLookupTable) To UBound(vLookupTable)[/INDENT]
[INDENT=2][COLOR=#ff0000]      sKey = vLookupTable(i, 1) '<---------------------------------  [B] Error kicks out here[/B][/COLOR][COLOR=#ff0000][/COLOR][/INDENT]
[INDENT=2]      If Not dicLookupTable.Exists(sKey) Then _[/INDENT]
[INDENT=2]         dicLookupTable(sKey) = vLookupTable(i, Cntr)[/INDENT]
[INDENT=2]   Next i[/INDENT]
[INDENT=2]   [/INDENT]
[INDENT=2]   Workbooks(ReturnTowb).Activate[/INDENT]
[INDENT=2]   [/INDENT]
[INDENT=2]   With Worksheets(MRV)[/INDENT]
[INDENT=2]   finalrow2 = myResults.SpecialCells(xlCellTypeLastCell).Row[/INDENT]
[INDENT=2]   vLookupValues = .Range(.Cells(myRefValues.Row, myRefValues.Column), .Cells(finalrow2, myRefValues.Column))[/INDENT]
[INDENT=2]      [/INDENT]
[INDENT=2]   For i = LBound(vLookupValues) To UBound(vLookupValues)[/INDENT]
[INDENT=2]      sKey = vLookupValues(i, 1)[/INDENT]
[INDENT=2]
[/INDENT]
[INDENT=2]      If dicLookupTable.Exists(sKey) Then[/INDENT]
[INDENT=2]         vLookupValues(i, 1) = dicLookupTable(sKey)[/INDENT]
[INDENT=2]      Else[/INDENT]
[INDENT=2]         vLookupValues(i, 1) = CVErr(xlErrNA)[/INDENT]
[INDENT=2]      End If[/INDENT]
[INDENT=2]   Next i[/INDENT]
[INDENT=2]   [/INDENT]
[INDENT=2]        .Range(MR).Resize(UBound(vLookupValues) - LBound(vLookupValues) + 1, 1) = vLookupValues[/INDENT]
[INDENT=2]     [/INDENT]
[INDENT=2]   End With[/INDENT]
[INDENT=2]End With[/INDENT]
[INDENT=2]
[/INDENT]
[INDENT=2]
[/INDENT]
[INDENT=2]Application.ScreenUpdating = True[/INDENT]
[INDENT=2]Application.EnableEvents = True[/INDENT]
[INDENT=2]
[/INDENT]
[INDENT=2]End Sub[/INDENT]

---

FORM CODE

---

Private Sub UserForm_Initialize()
        Dim wb As Workbook
    'Get the name of all the workbooks in the combobox
        For Each wb In Application.Workbooks
            LookupFrom.AddItem wb.Name
            LookupTo.AddItem wb.Name
            
        Next


        LookupFrom = ActiveWorkbook.Name
        
End Sub




Private Sub CommandButton1_Click()


LookupFromwb = Me.LookupFrom
ReturnTowb = Me.LookupTo


Unload Me




End Sub

 

[Jeffrey Mahoney]

Thank you for that. I'm looking at your code. Maybe I should've asked this before, I'm trying to figure out what you're trying to accomplish. You have two sets of data, one of them is the master library (of sorts), the other is a set of data that you want a column of values to equal the library values based on the value of "skey".

Did I hit near the mark?

Can you provide an example of skey.

Jeff

 

[Jeffrey Mahoney]

Are you opposed to me creating code that uses an application vlookup rather than using the scripting dictionary? Seems to me that if we did away with temporarily storing your library values and simply accessing them using Application.Vlookup() the routine would use less memory and it would be quicker because we don't have to take the time to store the library values one by one.

Jeff

 

[Jeffrey Mahoney]

If you agree to that last post, then I would need either a sample of your two tables or a good description of locations related to getting the library values and saving the values to your other data set.

Jeff

 

[Jeffrey Mahoney]

I'm not shy about receiving excel files through email.

 

[timmytonga]

Absolutely, If you want to take a stab at it. As far as sample data it can just be made up because the object of the macro is to be universal for excel spreadsheets. That is why I had the code prompt the user to pick reference data and return data as well as return location even if it was a different workbook and sheet. I do a lot of vlookups and most of the time the data is over 250K lines so instead of waiting 10 min to calculate I was trying to come up with a better solution.