エクセルでの特定条件下での入力重複チェック

Question

前提・実現したいこと

現在、カレンダー兼タスクリストを作成しています。
画像の様に、日付ごとに２列に分けていて、偶数列にタスク番号、奇数列はプルダウンで空白と×が選べるようになっていて、作業を行う日時にタスク番号を入力、その作業が終了したらタスク番号の右側のプルダウンを選択して×をつけて終わり。という流れにしています。

実際に行いたいことなのですが、
タスク番号を入力しても作業ができなかった場合に別の日にまた同じタスク番号を入れることがあるのですが、
タスク番号の横に×がついている（つまりタスク終了している）にもかかわらず、間違えてまた同じタスク番号を入れてしまった場合にポップアップで「その作業は終了しています！」等の警告が出るようにしたいのです。

VBAを始めたばかりで、いろんなところで聞きながら見よう見まねで作成中なのですが肝心なところのコードが全くわからず…
お力添えいただけますと助かります。

発生している問題・エラーメッセージ

エラーメッセージ

該当のソースコード

Private Sub Worksheet_Change(ByVal Target As Range) 

  Dim c As Range
  Dim wS As Worksheet
  Dim rng As Range
    If Intersect(Target, Range("B5:KU103")) Is Nothing Or Target.Count > 1 Then Exit Sub
      With Target
        If .Column Mod 2 = 1 Then
          Set wS = Worksheets("Sheet2")
            Set c = wS.Cells.Find(what:=.Offset(, -1), LookIn:=xlValues, lookAt:=xlWhole)
              If Not c Is Nothing Then
                c.Offset(1) = .Value
              End If
        End If 
　　　'上記コードは別の処理
        
        
      '下記コードが質問内容に該当するコードです  
        If .Column Mod 2 = 0 Then
           If Application.WorksheetFunction.CountIf(Range("B5:KU103"), Target.Value) > 1 Then
            Set rng = Range("B5:KU103").Find(what:=Target.Value, lookAt:=xlPart)
               If Not rng Is Nothing Then
             
                 If Not rng.Offset(0, 1).Value = "" Then　'この辺りの書き方がわかりません
                    MsgBox "重複しています！"
                    Target.Value ""
                 End If
               End If
           End If
        End If
        
      End With
End Sub 

Answer 1

入力値でシート内を検索し、見つかったセルの右隣りに×があるかないかで判定すればよいのですよね。
以下のコードは入力したタイミングのイベントでこの処理を行う例です。
参考にしてみてください。

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim f As Range
    Dim peke As Boolean
    Set f = Cells.Find(Target.Value)
    Do
        If f.Offset(0, 1).Value = "×" Then
            peke = True
            Exit Do
        End If
        Set f = Cells.FindNext(f)
    Loop Until f.Address = Target.Address

    If peke Then
        MsgBox "その作業は終了しています！"
    End If
End Sub

Comments

[city_yoshy]

ありがとうございます！
試しに入れてみたのですが、
一度タスク番号を入力したところを削除すると、数秒フリーズした後に下記エラーが出てきてしまうようです。
”アプリケーション定義またはオブジェクト定義のエラーです”
もしこれを回避する方法をご存知でしたら教えていただきたいのですが…

[ttyp03]

関数内先頭に以下を入れてみてください。
If IsEmpty(Target.Value) Then Exit Sub

[city_yoshy]

わー！無事動きました！ありがとうございます！大変助かりました！！

[city_yoshy]

解決した後にスミマセン・・・一つ問題が発生いたしまして、
例えばＢ8に101と入力(タスク終わらず)→F19に101と入力、タスク終了したので隣を×にする　とした場合なのですが、こういった場合に8行目と19行目の間の行に入力すると、チェックにひっかからないみたいなのです。。。（もちろん間の日付ではなく、後日のスケジュールに入力した場合です）
なぜか質問文に画像を載せることができなくてわかりづらく大変恐縮なのですが、
何か解決策はございますでしょうか…？

[ttyp03]

Findのパラメーターがいい加減過ぎました。すみません。
次のようにしてみてください。

Set f = Cells.Find(What:=Target.Value, After:=Target, LookAt:=xlWhole)

[city_yoshy]

動きました！ありがとうございました…！何度もすみませんでした！

Answer 2

これではどうでしょうか。
If Not rng Is Nothing Then
･･･････
End
この部分を入れ替え。

If Not Rng Is Nothing Then
    firstAddress = Rng.Address
    Do
        If Target.Row <> Rng.Row And Target.Column <> Rng.Column Then
            If Not Rng.Offset(0, 1).Value = "" Then
               MsgBox "重複しています！"
               Target.Value = ""
               Exit Do
            End If
        End If
        Set Rng = Range("B5:KU103").FindNext(Rng)
    Loop While Not Rng Is Nothing And Rng.Address <> firstAddress
End If

Comments

[city_yoshy]

ありがとうございます！差し替えてみたのですが、うまく動かないようです。
firstAddress 　に対して変数が定義されていないとエラーが出てきます…

[tosi]

firstAddressの前に下記を追加して下さい。
Dim firstAddress As String

[city_yoshy]

無事動きました！ありがとうございました！