VBA vlookup code error "Run Time Error 429"

D

Dokat

Active Member
Joined
Jan 19, 2015
Messages
304
Office Version
  1. 365
I have been using below vba code to vlookup between 2 worksheets for very large data set. It's been working fine until today where it started giving me run time error 429..


Code vlookup value in "Append worksheet" column D (4th column) in "DG Weekly Reporting - All Item Master RDH" table and return the values in H,K,LM,N...columns.


Does anyone come across similar issue where vba code all sudden not working and giving "Run-time error message '429'. ActiveX component cant create object"


When i debug it highlights below line in yellow.


"Set fWs = ThisWorkbook.Sheets("Append")"




Code: 
[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Sub Vlookup()[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]    OptimizeVBA True[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]    Dim startTime As Single, endTime As Single[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]    startTime = Timer[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]    Dim sWb As Workbook[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]    Dim fWs As Worksheet, sWs As Worksheet[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]    Dim slRow As Long, flRow As Long[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]    Dim pSKU As Range, luVal As Range[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]    Dim lupSKU As Range, outputCol As Range[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]    Dim vlookupCol As Object[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]    Set sWb = Workbooks.Open("G:\USNSH_DG\Reports\Segmentation\DG Weekly Reporting - All Item Master RDH.xlsx")[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]    Set sWs = sWb.Sheets("DG Weekly Reporting - All Item ")[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]   Set fWs = ThisWorkbook.Sheets("Append")[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]    slRow = sWs.Cells(Rows.Count, 4).End(xlUp).Row[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]    flRow = fWs.Cells(Rows.Count, 4).End(xlUp).Row[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]    Set pSKU = sWs.Range("D2:D" & slRow)[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]    Set lupSKU = fWs.Range("D2:D" & flRow)[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]    For i = 20 To 27[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]        Set outputCol = fWs.Range(fWs.Cells(2, i), fWs.Cells(flRow, i))[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]        Select Case i[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]            Case 20[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]                Set luVal = sWs.Range("H2:H" & slRow)[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]            Case 21[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]                Set luVal = sWs.Range("K2:K" & slRow)[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]            Case 22[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]                Set luVal = sWs.Range("L2:L" & slRow)[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]            Case 23[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]                Set luVal = sWs.Range("M2:M" & slRow)[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]            Case 24[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]                Set luVal = sWs.Range("N2:N" & slRow)[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]            Case 25[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]                Set luVal = sWs.Range("P2:P" & slRow)[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]            Case 26[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]                Set luVal = sWs.Range("Q2:Q" & slRow)[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]            Case 27[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]                Set luVal = sWs.Range("R2:R" & slRow)[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]        End Select[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]    'Build Collection[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]       Set vlookupCol = BuildLookupCollection(pSKU, luVal)[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]    'Lookup the values[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]       VLookupValues lupSKU, outputCol, vlookupCol[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]    Next i[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]    endTime = Timer[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]    Debug.Print (endTime - startTime) & " seconds have passed [VBA]"[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]    OptimizeVBA False[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]    sWb.Close False[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]    Set vlookupCol = Nothing[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]End Sub[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Function BuildLookupCollection(categories As Range, values As Range)[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]    Dim vlookupCol As Object, i As Long[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]    Set vlookupCol = CreateObject("Scripting.Dictionary")[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]    For i = 1 To categories.Rows.Count[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]        vlookupCol.Item(CStr(categories(i))) = values(i)[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]    Next i[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]    Set BuildLookupCollection = vlookupCol[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]End Function[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Sub VLookupValues(lookupCategory As Range, lookupValues As Range, vlookupCol As Object)[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]    Dim i As Long, resArr() As Variant[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]    ReDim resArr(lookupCategory.Rows.Count, 1)[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]    For i = 1 To lookupCategory.Rows.Count[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]        resArr(i - 1, 0) = vlookupCol.Item(CStr(lookupCategory(i)))[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]    Next i[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]    lookupValues = resArr[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]End Sub[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Sub OptimizeVBA(isOn As Boolean)[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]    Application.Calculation = IIf(isOn, xlCalculationManual, xlCalculationAutomatic)[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]    Application.EnableEvents = Not (isOn)[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]    Application.ScreenUpdating = Not (isOn)[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]    ActiveSheet.DisplayPageBreaks = Not (isOn)[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]End Sub[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]
[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]



Thank you
 

Excel Facts

Who is Mr Spreadsheet?
Author John Walkenbach was Mr Spreadsheet until his retirement in June 2019.
Sort by date Sort by votes
Try re-checking the sheet name "Append" in the workbook, otherwise, can't see anything obviously wrong with the code...
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Locked
  • Question
VBA Vlookup Code only returning first 62 values
Replies
3
Views
332
Fluff
Fluff
D
  • Question
Vlookup VBA returning Blank Values
Replies
2
Views
825
Fluff
Fluff
R
  • Solved
Import multi dat files in vba run-time error 13
2 3
Replies
25
Views
2K
Marc L
Marc L
03856me
  • Question
Error 91 using Function related to vlookup
Replies
1
Views
513
03856me
03856me
D
  • Question
looping through multiple workbooks copying file paths as Hyperlinks run time error 5
Replies
1
Views
854
Davavo
D

Forum statistics

Threads
1,215,013
Messages
6,122,694
Members
449,092
Latest member
snoom82

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top