Thanks Thanks:  0
Likes Likes:  0
Results 1 to 3 of 3

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

  1. #1
    Board Regular
    Join Date
    Oct 2008
    Location
    Bedfordshire (UK)
    Posts
    1,079
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

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

    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
    Sheet1

    *ABCDEFGHIJKLM
    1CodeDateWCompany_idVat IDCustomer keyCustomer nameProductIDProduct descriptionQTYSales amountCurrencyNIV
    215515620160111WFIFI0705224110713485MÄNTYHARJUN KONE-SÄHKÖ KY (TEKNISET C13T07154010Widget 1133.91EUR *NIV
    315515620160111WFIFI0753087210713116DATA-KOIVISTO OY C11CE27401Widget 223646EUR *NIV
    415515620160111WFIFI0753087210713116DATA-KOIVISTO OY SESHQ2329Widget 320.02EUR *NIV
    515515620160111WFIFI0204687010713494TURUN TIETOKESKUS OY C13T18164010Widget 4295.4EUR *NIV
    615515620160111WFIFI0204687010713494TURUN TIETOKESKUS OY C13T79014010Widget 5254.6EUR *NIV
    715515620160111WFIFI0924774710713510PCP PARTNER OY C13T694200Widget 64789.6EUR *NIV


    Excel tables to the web >> Excel Jeanie HTML 4

    My lookup table
    Lookup

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


    Excel tables to the web >> Excel Jeanie HTML 4

    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 by MartinL; Jan 14th, 2016 at 08:45 AM.

  2. #2
    MrExcel MVP
    Moderator
    RoryA's Avatar
    Join Date
    May 2008
    Location
    UK
    Posts
    32,336
    Post Thanks / Like
    Mentioned
    25 Post(s)
    Tagged
    3 Thread(s)

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

    Yes - you don't have a Resume statement to reset the exception. (See this page: On Error WTF? | Excel Matters)

  3. #3
    Board Regular
    Join Date
    Oct 2008
    Location
    Bedfordshire (UK)
    Posts
    1,079
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

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

    Quote Originally Posted by RoryA View Post
    Yes - you don't have a Resume statement to reset the exception. (See this page: On Error WTF? | Excel Matters)
    Thanks Rory
    Last edited by MartinL; Jan 14th, 2016 at 12:35 PM.

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •