Ajouter un nouveau nom à partir du formulaire utilisateur s'il ne figure pas dans la liste. Excel VBA

Question

Salut, je suis relativement nouveau à VBA mais j'ai réussi à adapter un peu de code et écrire un peu moi-même.

J'ai maintenant cependant un problème. J'ai le code ci-dessous que j'ai trouvé et adapté. Je présente un formulaire utilisateur et l'utilisateur entre un nom et d'autres informations.

Le code recherche dans la liste des noms et ajoute les autres informations à côté du nom. En écrivant ce qui est déjà là. Si j'ai un nouvel utilisateur, je dois ajouter le nom en bas et tout continue à bien fonctionner. Je me demandais si quelqu'un ici pouvait voir dans le code où j'ai besoin d'ajouter des lignes si le code ne trouve pas le nom dans la liste alors s'il l'ajoute en bas s'il vous plaît?

Private Sub txtName_AfterUpdate() 
    Dim intMyVal As String 
    Dim lngLastRow As Long 
    Dim strRowNoList As String 

intMyVal = txtName.Value 'Value to search for, change as required. 
    lngLastRow = Cells(Rows.Count, "AA").End(xlUp).Row 'Search Column AA, change as required. 

    For Each cell In Range("AA4:AA" & lngLastRow) 'Starting cell is AA4, change as required. 

     If cell.Value = intMyVal Then 

     If strRowNoList = "" Then 
      strRowNoList = strRowNoList & cell.Row 
      Else 
      strRowNoList = strRowNoList & ", " & cell.Row  
     End If 

     End If 

    Next cell 

End Sub 

Answer 1

Peut-être que c'est ce que vous cherchez?

a utilisé un drapeau pour vérifier si trouvé ou non

Private Sub txtName_AfterUpdate() 
    Dim intMyVal As String 
    Dim lngLastRow As Long 
    Dim strRowNoList As String 
    Dim flg As Boolean 

    intMyVal = txtName.Value 'Value to search for, change as required. 
    lngLastRow = Cells(Rows.Count, "AA").End(xlUp).Row 'Search Column AA, change as required. 
    flg=False 

    For Each cell In Range("AA4:AA" & lngLastRow) 'Starting cell is AA4, change as required. 

     If cell.Value = intMyVal Then 

     If strRowNoList = "" Then 
      strRowNoList = strRowNoList & cell.Row 
      flg=True 
      Else 
      strRowNoList = strRowNoList & ", " & cell.Row 
       flg=True  
     End If 

     End If 


    Next cell 
    if flg=False then Range("AA4:AA" & lngLastRow + 1) = txtName.value 

End Sub 

Answer 2

vraiment difficile à comprendre vos besoins

Peut-être qu'ils sont ceux-

Private Sub txtName_AfterUpdate() 
    Dim myVal As String, strRowNoList As String 
    Dim srchRng as Range 

    myVal = txtName.Value 'Value to search for, change as required. 
    With Worksheets("MySheet") '<~~ change it as per your actual sheet name 
    Set srchRng = .Range("AA4:AA" & .Cells(.Rows.Count, "AA").End(xlUp).Row) 
    For Each cell In srchRng 
     If cell.Value = myVal Then strRowNoList = strRowNoList & cell.Row & "," 
    Next cell 

    If strRowNoList <> "" Then 
     strRowNoList = Left(strRowNoList, Len(strRowNoList) - 1) 
    Else 
     strRowNoList = CStr(srchRng.Rows(srchRng.Rows.Count).Row + 1) 
    End If 
    End With 
End Sub 

Mais je suppose que vous devez passer strRowNoList à une routine qui fait l'écriture/écrasement.

Answer 3

Merci à tous pour votre aide et vos commentaires. J'ai trouvé un moyen de le faire en utilisant un gestionnaire d'erreurs et bien que je ne pense pas que la solution soit concise ou jolie, j'ai réussi à le faire fonctionner. Je suis sûr que certains des experts ici seraient en mesure de faire la même chose avec beaucoup moins de code si j'avais pu clarifier mes exigences.

Private Sub txtDirection_AfterUpdate() 
On Error GoTo MyerrorHandler: 
Dim intMyVal As String 
Dim lngLastRow As Long 
Dim strRowNoList As String 

intMyVal = txtName.Value 'Value to search for, change as required. 
lngLastRow = Cells(Rows.Count, "AA").End(xlUp).Row 'Search Column A, change as required. 

For Each cell In Range("AA4:AA" & lngLastRow) 'Starting cell is F2, change as required. 

    If cell.Value = intMyVal Then 
     If strRowNoList = "" Then 
      strRowNoList = strRowNoList & cell.Row 
     Else 
      strRowNoList = strRowNoList & ", " & cell.Row 
     End If 
    End If 
Next cell 

If txtDirection.Value <> "" Then 
Ureg.txtDirection.SetFocus 
Select Case txtDirection.Value 'If the user scans in 
    Case "IN" 
     Range("A2").Select 
ActiveCell.End(xlDown).Select 
LastRow = ActiveCell.Row 
Cells(LastRow + 1, 1).Value = txtDate.Text 
Cells(LastRow + 1, 2).Value = Time 
Cells(LastRow + 1, 3).Value = txtName.Text 
Cells(LastRow + 1, 4).Value = txtLocation.Text 
Cells(LastRow + 1, 5).Value = Range("F1").Value 
Cells(LastRow + 1, 6).Value = txtName.Text & txtLocation.Text 
Cells(strRowNoList, 28).Value = txtDirection.Text 
Cells(strRowNoList, 29).Value = txtDate.Text 
Cells(strRowNoList, 30).Value = Time 
Cells(strRowNoList, 31).Value = txtLocation.Text 
Range("A2").Select 
txtDate.Value = Date 
txtName.Text = "" 
txtLocation.Text = "" 
txtDirection.Text = "" 
Ureg.txtName.SetFocus 

     Case "OUT" 'If the user scans OUT 

Range("A2").Select 
ActiveCell.End(xlDown).Select 
LastRow = ActiveCell.Row 
Cells(LastRow + 1, 1).Value = txtDate.Text 
Cells(LastRow + 1, 2).Value = Time 
Cells(LastRow + 1, 3).Value = txtName.Text 
Cells(LastRow + 1, 4).Value = txtLocation.Text 
Cells(LastRow + 1, 5).Value = Range("F1").Value 
Cells(strRowNoList, 28).Value = txtDirection.Text 
Cells(strRowNoList, 29).Value = txtDate.Text 
Cells(strRowNoList, 30).Value = Time 
Cells(strRowNoList, 31).Value = txtLocation.Text 
Cells(LastRow + 1, 6).Value = txtName.Text & txtLocation.Text 
Range("H2").Select 
txtDate.Value = Date 
txtName.Text = "" 
txtLocation.Text = "" 
txtDirection.Text = "" 
Ureg.txtName.SetFocus 

     Case "NEW" 'Extra code if the user is set up as a NEW person No longer needed if the erro handler works. 
Range("A2").Select 
ActiveCell.End(xlDown).Select 
LastRow = ActiveCell.Row 
Cells(LastRow + 1, 1).Value = txtDate.Text 
Cells(LastRow + 1, 2).Value = Time 
Cells(LastRow + 1, 3).Value = txtName.Text 
Cells(LastRow + 1, 4).Value = txtLocation.Text 
Cells(LastRow + 1, 5).Value = Range("F1").Value 
Cells(lngLastRow + 1, 31).Value = txtName.Text 
Cells(lngLastRow + 1, 32).Value = "IN" 
Cells(lngLastRow + 1, 33).Value = txtDate.Text 
Cells(lngLastRow + 1, 34).Value = Time 
Cells(lngLastRow + 1, 35).Value = txtLocation.Text 
Cells(LastRow + 1, 6).Value = txtName.Text & txtLocation.Text 
Range("H2").Select 
txtDate.Value = Date 
txtName.Text = "" 
txtLocation.Text = "" 
txtDirection.Text = "" 
Ureg.txtName.SetFocus 

     Case Else 'Message if the user scannes something other than in , out or new. 
      'MsgBox "Please enter either IN or OUT" 
       Dim AckTime As Integer, InfoBox As Object 
    Set InfoBox = CreateObject("WScript.Shell") 
    'Set the message box to close after 10 seconds 
    AckTime = 5 
    Select Case InfoBox.Popup("Please enter either IN or OUT. Please try again.               (This window will close automatically                 after 5 seconds).", _ 
    AckTime, "Inccorect Destination Scanned", 0) 
     Case 1, -1 
      Exit Sub 
    End Select 
    End Select 
    End If 
    With ActiveWorkbook 
    .SaveCopyAs .Path & "\" & Format(Date, "yyyymmdd") & "-" & [A1] & ".xlsm" 'This will save the sheet evertime a user scan is complete. 

    'MsgBox strRowNoList 
    End With 
'End Sub 

MyerrorHandler: 'This adds the name of the uses to the list in AA if they are not there already and then finishes the same code as above for a booking in. No new user should be scanning out. 
If Err.Number = 13 Then 
Cells(lngLastRow + 1, 27).Value = txtName.Text 
Cells(lngLastRow + 1, 28).Value = "IN" 
Cells(lngLastRow + 1, 29).Value = txtDate.Text 
Cells(lngLastRow + 1, 30).Value = Time 
Cells(lngLastRow + 1, 31).Value = txtLocation.Text 
Range("H2").Select 
txtDate.Value = Date 
txtName.Text = "" 
txtLocation.Text = "" 
txtDirection.Text = "" 
Ureg.txtName.SetFocus 
End If 

End Sub 

Merci encore une fois à tous,