Find dato

Sæt denne ind under Kalenderens kode.

Ret navnet på kalenderen, hvis den ikke passer.

Private Sub Calendar1_Click()
Dim Nr1 As Boolean, Fad As String
Nr1 = False
r = Range("A65536").End(xlUp).Row
md = Month(Calendar1.Value)
aar = Year(Calendar1.Value)
For Each C In Range("A1:A" & r)
If Month(C) = md And Year(C) = aar Then
If Nr1 = False Then
Fad = C.Address
Nr1 = True
Else
Fad = Fad & "," & C.Address
End If
End If
Next
Range(Fad).Select

End Sub

Fungerer fint.
Har udvidet lidt, med også at finde dag.

Private Sub Calendar1_Click()
Dim Nr1 As Boolean, Fad As String
Nr1 = False
r = Range("A65536").End(xlUp).Row
dd = Day(Calendar1.Value)
md = Month(Calendar1.Value)
aar = Year(Calendar1.Value)
For Each C In Range("A1:A" & r)
If Month(C) = md And Year(C) = aar And Day(C) = dd Then
If Nr1 = False Then
Fad = C.Address
Nr1 = True
Else
Fad = Fad & "," & C.Address
End If
End If
Next
Range(Fad).Select

End Sub

Tak for hjælpen.

Når du vil finde dagen også, så.

Private Sub Calendar1_Click()
Dim Nr1 As Boolean, Fad As String
Nr1 = False
r = Range("A65536").End(xlUp).Row
For Each C In Range("A1:A" & r)
If C = Calendar1.Value Then
If Nr1 = False Then
Fad = C.Address
Nr1 = True
Else
Fad = Fad & "," & C.Address
End If
End If
Next
Range(Fad).Select

End Sub

For ikke at koden går i fejl ved at en dato ikke er der, så har jeg lige sat On error ind i denne.

Private Sub Calendar1_Click()
On Error Resume Next
Dim Nr1 As Boolean, Fad As String
Nr1 = False
r = Range("A65536").End(xlUp).Row
For Each C In Range("A1:A" & r)
If C = Calendar1.Value Then
If Nr1 = False Then
Fad = C.Address
Nr1 = True
Else
Fad = Fad & "," & C.Address
End If
End If
Next
Range(Fad).Select

End Sub

Kan jeg få en MsgBox ved manglende dato fejl.

Private Sub Calendar1_Click()
On Error Resume Next
Dim Nr1 As Boolean, Fad As String
Nr1 = False
r = Range("A65536").End(xlUp).Row
For Each C In Range("A1:A" & r)
If C = Calendar1.Value Then
If Nr1 = False Then
Fad = C.Address
Nr1 = True
Else
Fad = Fad & "," & C.Address
End If
End If
Next
Range(Fad).Select
If Nr1 = False Then msgbox" Dato eksisterer IKKE"
End Sub

Så skulle den vist være der.
Tak for hjælpen.

Hvordan får jeg skidtet til at virke, når datoen er efterfulgt af tidspunkt.
dd.mm.åååå tt.mm

Det virker kun når tid er 00:00

Private Sub Calendar1_Click()
On Error Resume Next
Dim Nr1 As Boolean, Fad As String
Nr1 = False
r = Range("A65536").End(xlUp).Row
For Each C In Range("A1:A" & r)
If Int(C) = Calendar1.Value Then 'DER ER RETTET HER
If Nr1 = False Then
Fad = C.Address
Nr1 = True
Else
Fad = Fad & "," & C.Address
End If
End If
Next
Range(Fad).Select
If Nr1 = False Then MsgBox " Dato eksisterer IKKE"
End Sub

Alletiders. Nu virker det.
Tak for hjælpen. Igen.