VBA vlookup code error "Run Time Error 429"

[Dokat]

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")"

[/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

 

[JackDanIce]

Try re-checking the sheet name "Append" in the workbook, otherwise, can't see anything obviously wrong with the code...