VBA Error handling stops working always on the same product (in this example)

MartinL

Well-known Member
Joined
Oct 16, 2008
Messages
1,097
I have a vlookup in my code with some error handling which for some reason suddenly does not work as expected, that is the error handler does not do it job and excel takes over why?

Always on widget 6 as in this example

My data
Excel Workbook
ABCDEFGHIJKLM
1CodeDateWCompany_idVat IDCustomer keyCustomer nameProductIDProduct descriptionQTYSales amountCurrencyNIV
215515620160111WFIFI0705224110713485MNTYHARJUN KONE-SHK KY (TEKNISETC13T07154010Widget 1133.91EUR *NIV
315515620160111WFIFI0753087210713116DATA-KOIVISTO OYC11CE27401Widget 223646EUR *NIV
415515620160111WFIFI0753087210713116DATA-KOIVISTO OYSESHQ2329Widget 320.02EUR *NIV
515515620160111WFIFI0204687010713494TURUN TIETOKESKUS OYC13T18164010Widget 4295.4EUR *NIV
615515620160111WFIFI0204687010713494TURUN TIETOKESKUS OYC13T79014010Widget 5254.6EUR *NIV
715515620160111WFIFI0924774710713510PCP PARTNER OYC13T694200Widget 64789.6EUR *NIV
Sheet1


My lookup table
Excel Workbook
AB
1ProductIDBarcode
2C13T071340218715946495484
3C13T071340118715946495453
4C13T071540208715946364063
5C13T071540108715946361246
6C13T071140118715946495439
7C13T071140218715946495460
8C13T180140108715946517926
9C13T180140208715946517933
10C13T071440118715946495545
11C13T071440218715946495491
12C13T180240108715946518022
13C13T180240208715946518039
14C13T180340108715946518046
15C13T180340208715946518053
16C13T180440108715946518060
17C13T071240118715946495446
18C13T071240218715946495477
19C13T180440208715946518077
20C13T180645108715946542560
21C13T180640208715946518176
22C13T180640108715946518169
Lookup


My Vba
Code:
Sub ML14Jan2016()
On Error GoTo MyErrorHandler:

Dim Ray As Variant, Ac As Long, Rw As Long, c As Long, Throw As String, Catch As Long, CatchList As String

Ray = ActiveSheet.Range("A1").CurrentRegion
ReDim nray(1 To UBound(Ray, 1) * UBound(Ray, 2), 1 To 10)
    nray(1, 1) = "Year": nray(1, 2) = "Week": nray(1, 3) = "StoreNm"
    nray(1, 4) = "StoreNo": nray(1, 5) = "Description": nray(1, 6) = "UID"
    nray(1, 7) = "Volume": nray(1, 8) = "Stock": nray(1, 9) = "Chain": nray(1, 10) = "Country":

c = 1

    For Rw = 2 To UBound(Ray, 1)

    ' Check UID is valid
    If (Left(Ray(Rw, 8), 4)) = "C13T" Then
    
        'If this lookup fails it should go to the error handler
        Throw = Application.WorksheetFunction.VLookup(Ray(Rw, 8), Sheets("Lookup").Range("A2:A22"), 1, False)
        
        c = c + 1

        nray(c, 1) = Left(Ray(Rw, 2), 4) + 0 'Year
        nray(c, 2) = DatePart("ww", DateSerial(Left(Ray(Rw, 2), 4), Mid(Ray(Rw, 2), 5, 2), Right(Ray(Rw, 2), 2) - 2)) 'Week
        nray(c, 3) = Ray(Rw, 7)      'StoreNm
        nray(c, 4) = Ray(Rw, 6)      'StoreNo
        nray(c, 5) = Ray(Rw, 9)      'Description
        nray(c, 6) = Application.WorksheetFunction.VLookup(Ray(Rw, 8), Sheets("Lookup").Range("A2:A22"), 2, False)       'UID
        nray(c, 7) = Ray(Rw, 10)     'Volume
        nray(c, 8) = 0               'Stock
        nray(c, 9) = "Prisma"
        nray(c, 10) = "FI"

MyErrorHandler:
If Err.Number = 1004 Then
    MsgBox "Inks Not found :" & Ray(Rw, 8)
    Catch = Catch + 1                                'Count of records not found
    CatchList = CatchList & vbNewLine & Throw        'List of product IDs not found
    Err.Number = 0                                   'reset error number
End If

    End If
    Next Rw

Sheets.Add(after:=Sheets(Sheets.Count)).Name = "Mysheet" 'Change name to suit

With ActiveSheet.Range("A1").Resize(c, 10)
     .Value = nray
     .Borders.Weight = 2
End With

If Catch > 0 Then MsgBox "Inks Not found :" & vbNewLine & CatchList

End Sub
Can anyone see whats wrong
 
Last edited:

Forum statistics

Threads
1,078,253
Messages
5,339,108
Members
399,279
Latest member
danidanidaniel

Some videos you may like

This Week's Hot Topics

Top