inputmaske til dato

Sub søg_dato()

Dim søg As Date, Data As Variant, I As Long, StrSøg As String
StrSøg = InputBox("Indtast data:  ", "Dato (DD,MM,ÅÅÅÅ)") ' Nu skal du bruge komma
If StrSøg = "" Then Exit Sub ' Ved Cancel afbrydes koden
søg = DateSerial(Split(StrSøg, ",")(2), Split(StrSøg, ",")(1), Split(StrSøg, ",")(0))

Data = Worksheets(3).Range("A1", Range("A65536").End(xlUp))
For I = 4 To UBound(Data)
  If Data(I, 1) = søg Then
  Range("A" & I & ":F" & I).ClearContents
  End If
Next
End Sub

lidt mere til at fange fejl i indtastningen


Sub søg_dato()

    Dim søg As Date, Data As Variant, I As Long, StrSøg As String
    StrSøg = InputBox("Indtast data:  ", "Dato (DD,MM,ÅÅÅÅ)")    ' Nu skal du bruge komma
   
    If StrSøg = "" Then Exit Sub    ' Ved Cancel  eller tom afbrydes koden
    If UBound(Split(StrSøg, ",")) < 2 Then ' tjekker om der er 2 kommaer
        MsgBox "Fejl i indtastning, husk DD,MM,ÅÅÅÅ"
        Exit Sub
    End If
    søg = DateSerial(Split(StrSøg, ",")(2), Split(StrSøg, ",")(1), Split(StrSøg, ",")(0))
   
    Data = Worksheets(3).Range("A1", Range("A65536").End(xlUp))
    For I = 4 To UBound(Data)
        If Data(I, 1) = søg Then
            Range("A" & I & ":F" & I).ClearContents
        End If
    Next
End Sub

Hej igen
Søge rutinen skal bruges i en userform, til styring af produkter. Når der tastes forkert i datoen, skal den stille sig i textboxen igen, så indtastningen kan gentages. Kan du fikse det?

Ret  TextBox1 til navnet på din tekstbox

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    Dim søg As Date, Data As Variant, I As Long, StrSøg As String
    StrSøg = TextBox1.Text    ' Nu skal du bruge komma
    If StrSøg = "" Then Exit Sub    ' Ved tom afbrydes koden
    If UBound(Split(StrSøg, ",")) < 2 Then    ' tjekker om der er 2 kommaer
        MsgBox "Fejl i indtastning, husk DD,MM,ÅÅÅÅ"
        TextBox1.SelStart = 0
        TextBox1.SelLength = Len(TextBox1)
        Cancel = True
        Exit Sub
    End If
    søg = DateSerial(Split(StrSøg, ",")(2), Split(StrSøg, ",")(1), Split(StrSøg, ",")(0))

    Data = Worksheets(3).Range("A1", Range("A65536").End(xlUp))
    For I = 4 To UBound(Data)
        If Data(I, 1) = søg Then
            Range("A" & I & ":F" & I).ClearContents
        End If
    Next

End Sub

Jeg lever stadig - men har været optage at andet arbejde - derfor den forsinkede tilbagemelding. Det ser lovende ud, jeg tester den lige og vender tilbage. :o)

Super - virker fint - helt som ønsket - lægger du et svar?

et svar ;-))