Error 1004 on VlookUp

F

Flavien

Board Regular
Joined
Jan 8, 2023
Messages
78
Office Version
  1. 365
Platform
  1. Windows
Hello, I made a code that allows me to forward a line to an email.
The code works great if the desired line is saved on one of the two tabs.
If the line I'm looking for doesn't exist at all, the first search works fine and displays a message to let me know that the program is going to look for the info in the second tab, but at that point, the code shows error 1004 on the line VLKUP_1 ignoring the line "On error GoTo InvalidVLKUP_2:

Does anyone know how to fix this?

VBA Code: 
Sub Acces_onglet_Modification_MAJ_FNC_EXTRAITE()

Dim email As Variant
Dim chemin As String, pos&
Dim Msg_VLKUP, Msg_PopUp  As String 'variable pour MsgBox
Dim Ext, VLKUP1, VLKUP2, VLKUP3, VLKUP4, VLKUP5, VLKUP6 As Variant
Dim varMsgBoxResutlt
Dim Msg, Style, Title, Response, MyString
Dim Doc_joint As Object
Dim xRg, xRgEach As Range
Dim xAddress, xRgVal As String
Dim xRgNum, xNum As Long
Dim Lig, I As Long
Dim WS1, WS2 As Worksheet
    
    Set WS2 = Worksheets("SUIVI")
    Set WS3 = Worksheets("Modification")

'   MAJ de l'écran
    Application.ScreenUpdating = False

'   appeler une FNC
    Ext = ThisWorkbook.Worksheets("Accueil").Range("Concat_Num_FNC").Value

'   Récupérer le nom du classeur
   chemin = ActiveWorkbook.Name
   pos = InStr(chemin, ".xlsm")

'   Afficher la feuille "Modification"
    Workbooks(chemin).Worksheets("Modification").Visible = True
    
'   Masquer le rectangle "Modifier"
    Workbooks(chemin).Worksheets("Modification").Shapes.Range(Array("Rectangle 1")).Visible = False

'   Afficher le rectangle "Test"
    Workbooks(chemin).Worksheets("Modification").Shapes.Range(Array("Rectangle 4")).Visible = True

'   Tester si le numéro de fiche existe sinon message d'erreur

On Error GoTo InvalidVLKUP:

    VLKUP1 = WorksheetFunction.VLookup(Ext, Worksheets("Tableau FNC").Range("Tableau_FNC"), 1, False) 'affiche numéro de FNC
    Workbooks(chemin).Worksheets("Modification").Range("FNC_Num_B") = VLKUP1
  
  
GoTo VLKUPOK:

InvalidVLKUP:


                Msg_1 = "La FNC que vous recherchez ne figure pas dans l'onglet Tableau FNC" & vbNewLine '& vbNewLine
                Msg_1 = Msg_1 & "Nous allons la rechercher dans l'onglet SUIVI" & vbNewLine '& vbNewLine
                MsgBox Msg_1, vbCritical

On Error GoTo InvalidVLKUP_2:
    VLKUP1_B = WorksheetFunction.VLookup(Ext, Worksheets("SUIVI").Range("Tableau_Suivi"), 1, False) 'Line of code in error if the line you are looking for does not exist on the second sheet
    Workbooks(chemin).Worksheets("Modification").Range("FNC_Num_B") = VLKUP1_B

GoTo VLKUPOK_2:


InvalidVLKUP_2:
Worksheets("Modification").Range("Saisie_B").Value = "Not Found" 'Range "Infos_Ilot" contient cellules Ilot_concerné / Rédacteur / Qualiticien

    For Each Cell In Worksheets("Modification").Range("Saisie_B")
        If Cell.Value = "Not Found" Then
        totalfound = totalfound + 1

        End If
    Next Cell

    MsgBox "Le numéro de FNC que vous recherchez ne figure pas dans votre extraction", vbCritical

    ThisWorkbook.Worksheets("Accueil").Range("Numéro").Activate

    Exit Sub


VLKUPOK:
VLKUPOK_2:


    Lig = 4
    
    For I = 2 To WS2.Range("A" & Rows.Count).End(xlUp).Row
        If WS2.Cells(I, 1) = Ext Then
           Range(WS2.Cells(I, "A"), WS2.Cells(I, "BD")).Copy: WS3.Cells(Lig, "A").PasteSpecial Paste:=xlPasteValues

        End If
    Next I

    Application.CutCopyMode = False

    Workbooks(chemin).Worksheets("Modification").Activate
    Workbooks(chemin).Worksheets("Modification").Range("Description_Défaut_B").Select

'   MAJ de l'écran
    Application.ScreenUpdating = True

End Sub
 

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).
Sort by date Sort by votes
Don't use On Error in this case: in case of error a "Resume" is needed in order to reenable the error handling procedure

What I suggest is using Application.VLookup instead of WorksheetFunction.VLookup:
VBA Code: 
VLKUP1_B = Application.VLookup(Ext, Worksheets("SUIVI").Range("Tableau_Suivi"), 1, False)
If VLookup fails, then VLKUP1_B will be in error and you can manage it using If IsError:
VBA Code: 
If IsError(VLKUP1_B) Then
    'What to do if lookup fails
Else
    'What to do if lookup returns a value
End If
Note that this require the variable VLKUP1_B be declared as Variant.

Try rearranging your code in this way...

Note also that your declarations are probably wrong; for example:
Dim WS1, WS2 As Worksheet
Click to expand...
In such a statement WS2 is type=Worksheet, but WS1 is a Variant; however in most of the cases it will work as expected

You should be explicit, if you wish to assign also the type:
VBA Code: 
Dim WS1 As Worksheet, WS2 As Worksheet
 
Upvote 0
Hello Anthony47,

Sorry for my late reply.
Your solution works perfectly, but I'm annoyed, because when I create a new row, it is copied to the worksheets("Tableau FNC").range("Tableau_FNC").
But I don't know why, the added lines aren't part of the range("Tableau_FNC"). I have to adapt the array manually and do a lot of tricks to rename it "Tableau_FNC".
FYI, in the Name Manager (Gestionnaire de noms / in french version), it is not possible to change the size of the table (Number of rows or columns).

Do you have an idea?



Below the updated code

VBA Code: 
Sub Acces_onglet_Modification_MAJ_FNC_EXTRAITE_2()  '25/01/2024

Dim email As Variant
Dim chemin As String, pos&
Dim Msg_VLKUP As String, Msg_PopUp  As String 'variable pour MsgBox
Dim Ext As Variant, VLKUP1 As Variant, VLKUP2 As Variant, VLKUP3 As Variant, VLKUP4 As Variant, VLKUP5 As Variant, VLKUP6 As Variant
Dim varMsgBoxResutlt
Dim Msg, Style, Title, Response, MyString
Dim Doc_joint As Object
Dim xRg As Range, xRgEach As Range
Dim xAddress As String, xRgVal As String
Dim xRgNum As Long, xNum As Long
Dim Lig As Long, I As Long
Dim WS1 As Worksheet, WS2 As Worksheet, WS3 As Worksheet
    
    Set WS2 = Worksheets("SUIVI")
    Set WS3 = Worksheets("Modification")

'   MAJ de l'écran
    Application.ScreenUpdating = False

'   appeler une FNC
    Ext = ThisWorkbook.Worksheets("Accueil").Range("Concat_Num_FNC").Value

'   Récupérer le nom du classeur
    chemin = ActiveWorkbook.Name
    pos = InStr(chemin, ".xlsm")

'   Afficher la feuille "Modification"
    Workbooks(chemin).Worksheets("Modification").Visible = True
    
'   Masquer le rectangle "Modifier"
    Workbooks(chemin).Worksheets("Modification").Shapes.Range(Array("Rectangle 1")).Visible = False

'   Afficher le rectangle "Test"
    Workbooks(chemin).Worksheets("Modification").Shapes.Range(Array("Rectangle 4")).Visible = True

'   Tester si le numéro de fiche existe sinon message d'erreur

    VLKUP1_B = Application.VLookup(Ext, Worksheets("SUIVI").Range("Tableau_Suivi"), 1, False)
    Workbooks(chemin).Worksheets("Modification").Range("FNC_Num_B") = VLKUP1_B
    
    
If IsError(VLKUP1_B) Then
    'What to do if lookup fails
    VLKUP1_C = Application.VLookup(Ext, Worksheets("Tableau FNC").Range("Tableau_FNC"), 1, False)
    Workbooks(chemin).Worksheets("Modification").Range("FNC_Num_B") = VLKUP1_C
        
        If IsError(VLKUP1_C) Then
            'What to do if lookup fails
            Msg_1 = "La FNC que vous recherchez ne figure pas dans l'onglet Tableau FNC" & vbNewLine '& vbNewLine
            Msg_1 = Msg_1 & "Nous allons la rechercher dans l'onglet SUIVI" & vbNewLine '& vbNewLine
            MsgBox Msg_1, vbCritical
     
            Exit Sub
        Else
            'What to do if lookup returns a value
            Workbooks(chemin).Worksheets("Modification").Range("FNC_Num_B") = VLKUP1_B
                
Lig = 4
    
For I = 2 To WS2.Range("A" & Rows.Count).End(xlUp).Row

    If WS2.Cells(I, 1) = Ext Then
    Range(WS2.Cells(I, "A"), WS2.Cells(I, "BH")).Copy: WS3.Cells(Lig, "A").PasteSpecial Paste:=xlPasteValues

    End If
Next I

    
End If
        
        
Else
    'What to do if lookup returns a value
    Workbooks(chemin).Worksheets("Modification").Range("FNC_Num_B") = VLKUP1_C
                
Lig = 4
    
For I = 2 To WS2.Range("A" & Rows.Count).End(xlUp).Row

    If WS2.Cells(I, 1) = Ext Then
    Range(WS2.Cells(I, "A"), WS2.Cells(I, "BH")).Copy: WS3.Cells(Lig, "A").PasteSpecial Paste:=xlPasteValues

    End If
Next I

    
End If
    

    Application.CutCopyMode = False

    Workbooks(chemin).Worksheets("Modification").Activate
    Workbooks(chemin).Worksheets("Modification").Range("Description_Défaut_B").Select

'   MAJ de l'écran
    Application.ScreenUpdating = True

End Sub
 
Upvote 0
There is a small error in the code from the previous post. Here's the OK version

VBA Code: 
Sub Acces_onglet_Modification_MAJ_FNC_EXTRAITE_2()  '25/01/2024

Dim email As Variant
Dim chemin As String, pos&
Dim Msg_VLKUP As String, Msg_PopUp  As String 'variable pour MsgBox
Dim Ext As Variant, VLKUP1 As Variant, VLKUP2 As Variant, VLKUP3 As Variant, VLKUP4 As Variant, VLKUP5 As Variant, VLKUP6 As Variant
Dim varMsgBoxResutlt
Dim Msg, Style, Title, Response, MyString
Dim Doc_joint As Object
Dim xRg As Range, xRgEach As Range
Dim xAddress As String, xRgVal As String
Dim xRgNum As Long, xNum As Long
Dim Lig As Long, I As Long
Dim WS1 As Worksheet, WS2 As Worksheet, WS3 As Worksheet
    
    Set WS1 = Worksheets("Tableau FNC")
    Set WS2 = Worksheets("SUIVI")
    Set WS3 = Worksheets("Modification")

'   MAJ de l'écran
    Application.ScreenUpdating = True

'   appeler une FNC
    Ext = ThisWorkbook.Worksheets("Accueil").Range("Concat_Num_FNC").Value

'   Récupérer le nom du classeur
    chemin = ActiveWorkbook.Name
    pos = InStr(chemin, ".xlsm")

'   Afficher la feuille "Modification"
    Workbooks(chemin).Worksheets("Modification").Visible = True
    
'   Masquer le rectangle "Modifier"
    Workbooks(chemin).Worksheets("Modification").Shapes.Range(Array("Rectangle 1")).Visible = False

'   Afficher le rectangle "Test"
    Workbooks(chemin).Worksheets("Modification").Shapes.Range(Array("Rectangle 4")).Visible = True

'   Tester si le numéro de fiche existe sinon message d'erreur

    VLKUP1_B = Application.VLookup(Ext, Worksheets("SUIVI").Range("Tableau_Suivi"), 1, False)
    Workbooks(chemin).Worksheets("Modification").Range("FNC_Num_B") = VLKUP1_B
    
    
If IsError(VLKUP1_B) Then
    'What to do if lookup fails
    VLKUP1_C = Application.VLookup(Ext, Worksheets("Tableau FNC").Range("Tableau_FNC"), 1, False)
    Workbooks(chemin).Worksheets("Modification").Range("FNC_Num_B") = VLKUP1_C
        
        If IsError(VLKUP1_C) Then
            'What to do if lookup fails
            Msg_1 = "La FNC que vous recherchez ne figure pas dans l'onglet Tableau FNC" & vbNewLine '& vbNewLine
            Msg_1 = Msg_1 & "Nous allons la rechercher dans l'onglet SUIVI" & vbNewLine '& vbNewLine
            MsgBox Msg_1, vbCritical
     
            Exit Sub
        Else
            'What to do if lookup returns a value
'            Workbooks(chemin).Worksheets("Modification").Range("FNC_Num_B") = VLKUP1_C
                
Lig = 4
    
For I = 2 To WS2.Range("A" & Rows.Count).End(xlUp).Row

    If WS1.Cells(I, 1) = Ext Then
    Range(WS1.Cells(I, "A"), WS1.Cells(I, "BH")).Copy: WS3.Cells(Lig, "A").PasteSpecial Paste:=xlPasteValues

    End If
Next I

    
End If
        
        
Else
    'What to do if lookup returns a value
    Workbooks(chemin).Worksheets("Modification").Range("FNC_Num_B") = VLKUP1_C
                
Lig = 4
    
For I = 2 To WS1.Range("A" & Rows.Count).End(xlUp).Row

    If WS2.Cells(I, 1) = Ext Then
    Range(WS2.Cells(I, "A"), WS2.Cells(I, "BH")).Copy: WS3.Cells(Lig, "A").PasteSpecial Paste:=xlPasteValues

    End If
Next I

    
End If
    

    Application.CutCopyMode = False

    Workbooks(chemin).Worksheets("Modification").Activate
    Workbooks(chemin).Worksheets("Modification").Range("Description_Défaut_B").Select

'   MAJ de l'écran
    Application.ScreenUpdating = True

End Sub
 
Upvote 0
Finally I'm completely lost, the code seemed to work until I added lines. Manual operation to refresh the table. And all in all, the new lines are not taken into account.
 
Upvote 0
So, which is the status now? Can you explain how your data are organized and where you added lines? A picture, at least
 
Upvote 0
You must log in or register to reply here.

Similar threads

F
  • Solved
set object doesn't work
Replies
3
Views
330
Fluff
Fluff
F
  • Question Question
open a file based on VLookUp result
Replies
0
Views
306
Flavien
F
F
  • Solved
Error '-2147319767 (80028029)'
Replies
3
Views
533
RoryA
RoryA
F
  • Question Question
Edit existing code
2
Replies
10
Views
530
Flavien
F
F
  • Solved
Macro runs perfectly on 1 computer but not on another
Replies
8
Views
495
Fluff
Fluff

Forum statistics

Threads
1,224,822
Messages
6,181,165
Members
453,021
Latest member
Justyna P

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