Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim cel As Range, c As Range, dossier As String
On Error Resume Next
For Each c In Range("a2:a23")
dossier = Dir("C:\Windows\" & c.Offset(0, 0).Value, vbDirectory)
Application.Wait (Now + TimeValue("00:00:01"))
Application.Cursor = xlNorthwestArrow
With Range("a2:a23")
Set cel = .Find(dossier, , xlValues, xlWhole)
If Not cel Is Nothing Then
Application.Wait (Now + TimeValue("00:00:01"))
Application.Cursor = xlNorthwestArrow
cel.Offset(0, 1) = "It's OK !"
cel.Offset(0, 1).Interior.Color = xlNone
End If
If c.Offset(0, 1).Value = "" Then
c.Offset(0, 1) = "None"
c.Offset(0, 1).Interior.Color = vbRed
End If
t = Timer + 1.5: Do Until Timer > t: DoEvents: Loop
End With
Next c
MsgBox "Research Finished", , "RESEARCH": _
Range("B:B").Columns.Delete: Cancel = True: Application.Cursor = xlDefault: Exit Sub
Cancel = True
End Sub