Afficher les résultats dans un msgbox

Bonjour à tous,

Pourriez-vous m'aider à résoudre ce problème ?

Objectif : Encoder un nouveau produit dans un textbox (TB_PROD) et :

1) vérifier s'il existe déjà dans la BDD (pas de doublon possible) -> msgbox

2) afficher les produits similaires éventuels (XlPart).

Le résultat de la recherche devrait s'afficher dans un MSGBOX (plusieurs lignes possible)

La base de données est située dans la feuille INVENTAIRE -> plage nommée "LISTE".

Exemple :

TAPE12mm blanc

TAPE12mm noir

TAPE6mm blanc

TAPE9mm vert

En tapant "TAPE12" dans le textbox et sans valider (TB_PROD_BeforeUpdate), un msgbox apparait en mentionnant uniquement les TAPE12 repris ci dessus. Ceci évitera d'encoder malencontreusement un nouveau produit TAPE12.

Merci d'avance pour votre aide précieuse

Private Sub TB_PROD_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Dim rg, cel As Range
Dim Msg As String
Dim f As Worksheet

Set f = Sheets("INVENTAIRE")

If Me.TB_PROD.Text = "" Then Exit Sub

For Each cel In f.Range("LISTE")

Set rg = f.Range("LISTE").Find(what:=Me.TB_PROD.Value, lookat:=xlPart)

If rg Is Nothing Then

    Exit Sub

Else

    MsgBox "Des produits similaires ont été trouvés :"

    ????????
    ????????
    ????????

End If

Next

Set rg = Nothing

End Sub

bonjour,

essaie ceci

Private Sub TB_PROD_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
    Dim rg, cel As Range
    Dim Msg As String
    Dim f As Worksheet

    Set f = Sheets("INVENTAIRE")

    If Me.TB_PROD.Text = "" Then Exit Sub

    For Each cel In f.Range("LISTE")

        Set rg = f.Range("LISTE").Find(what:=Me.TB_PROD.Value, lookat:=xlPart)

        If rg Is Nothing Then

            Exit Sub

        Else

            m = "Des produits similaires ont été trouvés :"
            fa = rg.Address
            Do
                m = m & vbCrLf & rg.Value
                rg = f.Range("liste").FindNext(rg)
            Loop Until rg Is Nothing Or rg.Address = fa
            MsgBox m

        End If

    Next

    Set rg = Nothing

End Sub

Merci h2so4 pour ta proposition qui est presque parfaite

Il fallait juste ajouter SET devant

rg = f.Range("liste").FindNext(rg)

Le code ci-dessous est donc fonctionnel.

Merci

Private Sub TB_PROD_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)

Dim rg, cel As Range
Dim M As String
Dim f As Worksheet
Dim fa

Set f = Sheets("INVENTAIRE")

If Me.TB_PROD.Text = "" Then Exit Sub

For Each cel In f.Range("LISTE")

    Set rg = f.Range("LISTE").Find(what:=Me.TB_PROD.Value, lookat:=xlPart)

    If rg Is Nothing Then

        Exit Sub

        Else

            M = "Des produits similaires ont été trouvés :" & vbCrLf
            fa = rg.Address
            Do
                M = M & vbCrLf & rg.Value

                Set rg = f.Range("LISTE").FindNext(rg)
            Loop Until rg Is Nothing Or rg.Address = fa

    End If

Next

MsgBox M, vbOKOnly, ""

Set rg = Nothing

End Sub