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]

Do you need to store the data into the arrays named vLookupTable and vLookupValues? Consider just reading the values from the sheets.

  Dim vLookupTable As Range
  Dim Cel As Range
  
  '...
  Set vLookupTable = .Range(.Cells(MyLookValues.Row, MyLookValues.Column), .Cells(finalrow, MyLookValues.Column))
  For Each Cel In Range
    sKey = Cel.Value
    If Not dicLookupTable.Exists(sKey) Then dicLookupTable(sKey) = Cel.Offset(0, Cntr).Value
  Next Cel
  '...

 

[Jeffrey Mahoney]

Setting the vLookupTable range to only the left column is the key.

 

[timmytonga]

I replaced the code with what you said above but it is still erroring out. Disclaimer this is my first time using a scripting dictionary.

Am I a bit confused how to approach the next chunk of code

'...

With Worksheets(MLV)
    finalrow = MyLookValues.SpecialCells(xlCellTypeLastCell).Row



     Set vLookupTable = .Range(.Cells(MyLookValues.Row, MyLookValues.Column), .Cells(finalrow, MyLookValues.Column))
    For Each Cel In vLookupTable
        sKey = Cel.Value
        If Not dicLookupTable.Exists(sKey) Then dicLookupTable(sKey) = Cel.Offset(0, Cntr).Value
    Next Cel




   Workbooks(ReturnTowb).Activate
   
   With Worksheets(MRV)
   finalrow2 = myResults.SpecialCells(xlCellTypeLastCell).Row
   vLookupValues = .Range(.Cells(myRefValues.Row, myRefValues.Column), .Cells(finalrow2, myRefValues.Column))
      
   For i = LBound(vLookupValues) To UBound(vLookupValues)
      sKey = vLookupValues(i, 1)   '<------------------------------------------ New point of Error


      If dicLookupTable.Exists(sKey) Then
         vLookupValues(i, 1) = dicLookupTable(sKey)
      Else
         vLookupValues(i, 1) = CVErr(xlErrNA)
      End If
   Next i
   
        .Range(MR).Resize(UBound(vLookupValues) - LBound(vLookupValues) + 1, 1) = vLookupValues
     
   End With
End With

 

[Jeffrey Mahoney]

Make sure you get the DIM statements at the top. Make sure you change all the red text including the mistake I made on the original. Test this and see if you get an error. I can't test it here.

Sub GetValuesFromSheet()
  Dim vLookupTable As Range
  Dim vLookupValues As Range
  Dim Cel As Range
  
  '...
  Set vLookupTable = .Range(.Cells(MyLookValues.Row, MyLookValues.Column), .Cells(finalrow, MyLookValues.Column))
  For Each Cel In [COLOR="#FF0000"]vLookupTable[/COLOR]    
     sKey = Cel.Value
    If Not dicLookupTable.Exists(sKey) Then dicLookupTable(sKey) = Cel.Offset(0, Cntr).Value
  Next Cel
  '...
  
  
  [COLOR="#FF0000"]Set[/COLOR] vLookupValues = .Range(.Cells(myRefValues.Row, myRefValues.Column), .Cells(finalrow2, myRefValues.Column))
      
   [COLOR="#FF0000"]For Each Cel In vLookupValues
      sKey = Cel.Value
      If dicLookupTable.Exists(sKey) Then
        Cel.Value = dicLookupTable(sKey)
      Else
         Cel.Value = CVErr(xlErrNA)
      End If
   Next I
   '.Range(MR).Resize(UBound(vLookupValues) - LBound(vLookupValues) + 1, 1) = vLookupValues[/COLOR] [COLOR="#00FF00"]remove this[/COLOR]
'...

End Sub

 

[timmytonga]

Also Thank you very much for your assistance this code has been driving me nuts for the past 2 weeks and I want you to know that your help is very much appreciated.

 

[Jeffrey Mahoney]

You're welcome. I've not worked with the Dictionary Scripting either, but it seemed logical.

 

[timmytonga]

Doesn't look like my last post posted but I am still running into issues.

First issue, this code does work on smaller sets of data as did my original but when I try it on my files which are 250k+ rows it errors out.
Second, on the smaller set of data i realized it is no longer outputting the results into the correct column. The original code hat the results output to the user chosen column in Variable "myResults" where as it is outputting the results to the user chosen column in variable "myRefValues"

With Worksheets(MLV)    finalrow = MyLookValues.SpecialCells(xlCellTypeLastCell).Row


     Set vLookupTable = .Range(.Cells(MyLookValues.Row, MyLookValues.Column), .Cells(finalrow, MyLookValues.Column))
    For Each Cel In vLookupTable
        sKey = Cel.Value
        If Not dicLookupTable.Exists(sKey) Then dicLookupTable(sKey) = Cel.Offset(0, Cntr).Value
    Next Cel


   Workbooks(ReturnTowb).Activate
   
   With Worksheets(MRV)
   finalrow2 = myResults.SpecialCells(xlCellTypeLastCell).Row


    Set vLookupValues = .Range(.Cells(myRefValues.Row, myRefValues.Column), .Cells(finalrow2, myRefValues.Column))
      
        For Each Cel In vLookupValues
            sKey = Cel.Value    '[COLOR=#ff0000]<---------------------------------------New location of runtime error 13[/COLOR]
        
            If dicLookupTable.Exists(sKey) Then
                Cel.Value = dicLookupTable(sKey)
            Else
                Cel.Value = CVErr(xlErrNA)
            End If
        Next [COLOR=#ff0000]Cel[/COLOR]
   
  
   End With
End With




End Sub

 

[Jeffrey Mahoney]

Not at my computer. I need to see more of your code or at least how you are declaring your variables, especially skey.

 

[timmytonga]

Hmmm

I have Skey as string.

The Form has been unchanged from the original post above

Public LookupFromwb As StringPublic ReturnTowb As String


Sub FAST_VLOOKUP_TEST()


Dim dicLookupTable As Scripting.Dictionary
Dim i As Long
Dim sKey As String


  Dim vLookupTable As Range
  Dim vLookupValues As Range
  Dim Cel As Range




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
Dim finalrow2 As Long
Dim Cntr As Integer


 Cntr = (MyresultValues.Column - MyLookValues.Column)


Workbooks(LookupFromwb).Activate


With Worksheets(MLV)
    finalrow = MyLookValues.SpecialCells(xlCellTypeLastCell).Row


     Set vLookupTable = .Range(.Cells(MyLookValues.Row, MyLookValues.Column), .Cells(finalrow, MyLookValues.Column))
    For Each Cel In vLookupTable
        sKey = Cel.Value
        If Not dicLookupTable.Exists(sKey) Then dicLookupTable(sKey) = Cel.Offset(0, Cntr).Value
    Next Cel


   Workbooks(ReturnTowb).Activate
   
   With Worksheets(MRV)
   finalrow2 = myResults.SpecialCells(xlCellTypeLastCell).Row


    Set vLookupValues = .Range(.Cells(myRefValues.Row, myRefValues.Column), .Cells(finalrow2, myRefValues.Column))
      
        For Each Cel In vLookupValues
            sKey = Cel.Value
        
            If dicLookupTable.Exists(sKey) Then
                Cel.Value = dicLookupTable(sKey)
            Else
                Cel.Value = CVErr(xlErrNA)
            End If
        Next Cel
   
  
   End With
End With




End Sub