Extra argument toevoegen lukt niet!!!!

[perry99]

Hallo,

Ik heb een probleem met het toevoegen van een extra argument.
Kom er niet uit, hoop dat één van jullie mij kan helpen met onderstaande VBA.
Hetgeen wat ik wil toevoegen staat in de VBA in het groen.

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Row > 40 And Target.Column = 3 Then
x = Target.Value
    If Len(x) = 6 Then x = "0" & Target.Value
    If Len(x) = 5 Then x = "00" & Target.Value
    
Set B1 = Worksheets("9 Miljoen").Cells.Find(x, , xlValues, xlWhole)
Set B2 = Workbooks("artikelbestand1.xls").Sheets("Code1").Cells.Find(x, , xlValues, xlWhole)
[COLOR="darkgreen"][B]Rem Set B3 = Worksheets("Standaard").Cells.Find(x, , xlValues, xlWhole)[/B][/COLOR]

If B1 Is Nothing And B2 Is Nothing And B3 Is Nothing Then ActiveCell.Offset(-1, 0).ClearContents: ActiveCell.Offset(-1, -1).ClearContents: ActiveCell.Offset(-1, 0).Select: MsgBox "artikelnummer bestaat niet": Exit Sub

       If Not B1 Is Nothing Then
        Target.Offset(, 4) = B1.Offset(, 1).Value
        Target.Offset(, 10) = B1.Offset(, 2).Value
   
 Else

        Target.Offset(, 4) = B2.Offset(, 2).Value
        Target.Offset(, 10) = B2.Offset(, 3).Value
  
 [COLOR="darkgreen"][B] Rem Else
        Rem If Not B3 Is Nothing Then
        Rem Target.Offset(, 4) = B3.Offset(, 3).Value
        Rem Target.Offset(, 10) = B3.Offset(, 4).Value[/B][/COLOR]        
   
 End If
    End If
    End Sub

Alvast bedankt voor het meedenken.

Groetjes,

Perry :thumb::thumb::thumb:

 

[HSV]

Probeer het eens zo (ongetest).

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Row > 40 And Target.Column = 3 Then
x = Target.Value
    If Len(x) = 6 Then x = "0" & Target.Value
    If Len(x) = 5 Then x = "00" & Target.Value
    
Set B1 = Worksheets("9 Miljoen").Cells.Find(x, , xlValues, xlWhole)
Set B2 = Workbooks("artikelbestand1.xls").Sheets("Code1").Cells.Find(x, , xlValues, xlWhole)

Set B3 = Worksheets("Standaard").Cells.Find(x, , xlValues, xlWhole)

If B1 Is Nothing And B2 Is Nothing And B3 Is Nothing Then ActiveCell.Offset(-1, 0).ClearContents: ActiveCell.Offset(-1, -1).ClearContents: ActiveCell.Offset(-1, 0).Select: MsgBox "artikelnummer bestaat niet": Exit Sub

       If Not B1 Is Nothing Then
        Target.Offset(, 4) = B1.Offset(, 1).Value
        Target.Offset(, 10) = B1.Offset(, 2).Value
   
 
  
  ElseIf Not B3 Is Nothing Then
         Target.Offset(, 4) = B3.Offset(, 3).Value
         Target.Offset(, 10) = B3.Offset(, 4).Value
   
   Else
        Target.Offset(, 4) = B2.Offset(, 2).Value
        Target.Offset(, 10) = B2.Offset(, 3).Value
   
 End If
    End If
    End Sub

 

[perry99]

Hallo Harry,

Bedankt voor het meedenken, het werkt als een zonnetje.

Ik kan maar één ding zeggen:

RESPEKT

Nogmaals mijn dank.

Groetjes,

Perry :thumb::thumb::thumb: