ben eventjes het noorden kwijt met zoekfunctie in vba

[gast0660]

Hoi,
Ik wil een zoekfunctie inbouwen in een stukje VBA, maar blijf maar over het probleem heen kijken
Ik heb deze code (geen probleem)

Private Sub CommandButton1_Click()
 Dim x As Control
    If Me.TextBox1.Value = "" Then
        MsgBox "Geef een afspraak in!"
        Exit Sub
        Else
    For Each x In Frame1.Controls '
              If x.Value = True Then
               Label2.Caption = TextBox1.Text & " - " & x.Caption & " uur "
        Cells(Range("A65000").End(xlUp).Row + 1, 4) = Label2
              End If
          Next
        End If
    TextBox1.Value = ""
    TextBox1.SetFocus
    End Sub

En deze code (ook geen probleem)

Private Sub CommandButton1_Click()
    If Me.TextBox1.Value = "" Then
        MsgBox "Geef een datum in!"
        Exit Sub
   ElseIf Application.CountIf([D:D], Me.TextBox1.Value) > 0 Then
        MsgBox "Deze datum bestaat al!."
    Else
        Cells(Range("D65000").End(xlUp).Row + 1, 4) = Me.TextBox1
        UserForm1.Hide
    End If
    TextBox1.Value = ""
    TextBox1.SetFocus
End Sub

Ik probeer het zoekgedeelte van het tweede stukje code in het eerste stukje code te krijgen, zodanig dat de eerste code eerst zoekt naar dubbele waarden vooraleer de nieuwe ingave wordt opgeslagen.
Ik blijf er echter over zien

Ieder suggestie is welkom
mvg

 

[edmoor]

Stukje positief bedoelde kritiek.
Misschien moet je eerst eens de boel zodanig schrijven dat duidelijk is wat waar gebeurd en welke blokken aan If..Then..Else..End If en For.. Next bij elkaar horen.
Dit is je eerste code, maar dan, naar mijn mening, een stuk duidelijker leesbaar, waardoor je misschien zelf sneller ziet wat je moet doen om je gewenste functionaliteit in orde te krijgen:

Private Sub CommandButton1_Click()
    Dim x As Control
    
    If Me.TextBox1.Value = "" Then
        MsgBox "Geef een afspraak in!"
        Exit Sub
    End If

    For Each x In Frame1.Controls '
        If x.Value = True Then
            Label2.Caption = TextBox1.Text & " - " & x.Caption & " uur "
            Cells(Range("A65000").End(xlUp).Row + 1, 4) = Label2
        End If
    Next x
    
    TextBox1.Value = ""
    TextBox1.SetFocus
End Sub

 

[gast0660]

Hoi,
klopt Edmoor maar had al zo zitten klooien om de zoekfunctie erin te krijgen, origineel was de code een beetje netter

 

[HSV]

Misschien zo.

Private Sub CommandButton1_Click()
Dim x As Control
If Me.TextBox1.Value = "" Then
        MsgBox "Geef een afspraak in!"
        Exit Sub
  Else
          For Each x In Frame1.Controls
            If x.Value = True Then
                 If Application.CountIf([D:D], TextBox1.Value & " - " & x.Caption & " uur ") = 0 Then
                   Label2.Caption = TextBox1.Text & " - " & x.Caption & " uur "
                   Cells(Range("A65000").End(xlUp).Row + 1, 4) = Label2
                 Else
                   MsgBox "Deze datum bestaat al!."
                 End If
            End If
         Next
   End If
TextBox1.Value = ""
TextBox1.SetFocus
End Sub

 

[snb]

Private Sub CommandButton1_Click()
    If TextBox1.Value = "" Then
        c00 = "Voer een datum in."
   ElseIf Application.CountIf([sheet1!D:D], TextBox1.Value) > 0 Then
        c00 = "Deze datum bestaat al."
    Else
        For Each it In frame1.Controls
          If it Then
             Label2.Caption = TextBox1.Text & " - " & it.Caption & " uur"
             Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 3) = Label2.Caption
             Exit For
          End If
        Next
        UserForm1.Hide
    End If

    if c00<>"" then
       msgbox c00
       TextBox1.Value = ""
       TextBox1.SetFocus
    end if
End Sub

Het is natuurlijk handiger voor een afspraak een combobox met geldige data te maken. Is de controle achteraf niet nodig.

 

[edmoor]

En dit:

    If Me.TextBox1.Value = "" Then
        MsgBox "Geef een afspraak in!"
        Exit Sub
    End If

Kennelijk gaat het om een afspraak.
Waarom heet dat object dan nog Textbox1 en niet txbAfspraak?
En Label2 dan lblAfspraak?
Zoals eerder al gezegd, kritiek, maar zoals altijd, positief bedoeld

 

[snb]

@ed

Bij mij zouden die gewoon T_0 en L_0 'heten'.

 

[edmoor]

Ik kies altijd voor leesbare zaken zodat in 1 oogopslag zichtbaar is met welke objecten je bezig bent. Niet alleen voor mezelf maar ook vanwege overdraagbaarheid.
Maar zo heeft een ieder z'n eigen methoden.

 

[gast0660]

Hallo beste helpers
De code van HSV werkt perfect
Bij deze, de vraag is opgelost
Aan iedereen, hartelijk dank voor het meedenken, en ik neem alle tips natuurlijk mee.
Groetjes