VBE ユーザーフォーム重複・空白チェック（VBE初心者）

VBE初心者ですみません。
VBEコーディングしていたのですが、VBE起動はするのですが永遠に終わらずにフリーズしてしまします。
助けていただけると幸いです。
内容は下記になります。

（”TBL_2021年度”）のシート上にあるユーザーフォームを使い（”TBL_2021年度”）のシートの最下行にデータ登録を行いたい。
■詳細
登録内容は下記（ユーザーフォーム）
・氏名（空白・重複チェック）
・部署（空白チェック）
・利用開始日（空白チェック）
・PC分類（空白チェック）
・引当PC（空白チェック）
・備考

上記内容で登録するのですが、まずユーザーフォーム登録時に下記TextBoxが空白かチェックする機能をつけています。
・氏名（空白・重複チェック）
・部署（空白チェック）
・利用開始日（空白チェック）
・PC分類（空白チェック）
・引当PC（空白チェック）
上記内容に空白がなかった場合、（”TBL_2021年度”）のシートのB列の氏名に今回追加する氏名が重複していないかチェックします。

チェックした結果重複していなければ、（”TBL_2021年度”）のシートの最下行にデータ追加及び、メール（ベッキー）にて内容送信するようにしたいのですが可能でしょうか？

私、初心者なので、具体的なコード例があると幸いです。

下記、作成したコード内容です。

ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー

Sub フォーム起動_Click()

登録foam.Show

End Sub

'ユーザーフォーム登録をクリック
Private Sub page1登録_Click()

'更新画面の停止
Application.ScreenUpdating = False

If TextBox氏名 = "" Or ComboBox使用分類 = "" Or ComboBox部署 = "" Or TextBox利用開始日 = "" Or TextBoxPC分類 = "" Or TextBo引当PC = "" Then
MsgBox "未入力箇所があります"
Else

If Range("B:B").Value = TextBox氏名 Then
MsgBox ("対象者が重複しています")
Else

If Range("BC6").Offset(1) = "" Then
Range("BC6").Offset(1).Value = TextBox氏名.Value
Range("BC6").Offset(1, 1).Value = ComboBox部署.Value
Range("BC6").Offset(1, 2).Value = TextBox利用開始日.Value
Range("BC6").Offset(1, 3).Value = TextBoxPC分類.Value
Range("BC6").Offset(1, 4).Value = TextBox引当PC.Value
Range("BC6").Offset(1, 4).Value = TextBox使用分類.Value
Range("BC6").Offset(1, 5).Value = TextBoxpage1備考.Value
End If

Range("B6").End(xlDown).Offset(1).Value = TextBox氏名.Value
Range("BC6").End(xlDown).Offset(1).Value = ComboBox部署.Value
Range("BD6").End(xlDown).Offset(1).Value = TextBox利用開始日.Value
Range("BE6").End(xlDown).Offset(1).Value = TextBoxPC分類.Value
Range("BF6").End(xlDown).Offset(1).Value = TextBox引当PC.Value
Range("BF6").End(xlDown).Offset(1).Value = TextBox使用分類.Value
Range("BG6").End(xlDown).Offset(1).Value = TextBoxpage1備考.Value

End If
End If

Sheets("TBL_2021年度").Select
strTO = Range("D3") '宛先アドレス
strCC = Range("E3") ' CCアドレス
strBCC = Range("F3") 'BCCアドレス
strSubject = Range("G3") 'タイトル文
strBody = Range("H3:M3") '本文
Shell "C:Program Files (x86)RimArtsB2B2.exe mailto:" & strTO & "?cc=" & strCC & "?bcc=" & strBCC & " ?&subject=" & strSubject & "&body=" & strBody, vbNormalFocusocus

Unload 登録foam
Application.ScreenUpdating = Ture
End Sub

質問者からの補足コメント

• 回答ありがとうございます。
  もし、B列にTextBox氏名に書いてある内容があれば（重複しています）メッセージを出すようにするように、書いたつもりでした。
  具体的にどのように修正すれば改善できるでしょうか？

  No.2の回答に寄せられた補足コメントです。 補足日時：2021/08/22 17:25

No.6 回答者： Qchan1962 回答日時： 2021/08/29 10:21

解決出来たかな？

＞（”TBL_2021年度”）のシート上にあるユーザーフォームを使い（”TBL_2021年度”）のシートの最下行にデータ登録を行いたい。
＞チェックした結果重複していなければ、（”TBL_2021年度”）のシートの最下行にデータ追加及び、メール（ベッキー）にて内容送信する

すべてのコントロールが設置されたフォームモジュールに
下記、Private Sub page1登録_Click()～End Functionまで
すべてをコピペ

'ユーザーフォーム登録をクリック
Private Sub page1登録_Click()
Dim strMsg As String, strTO As String, strCC As String
Dim strBCC As String, strSubject As String, strBody As String
Dim dataAry(5)
If CHK_Val(strMsg) <> "" Then
MsgBox "未入力箇所" & vbCrLf & vbCrLf & _
strMsg & vbCrLf & "上記項目を入力してください"
Exit Sub
End If
'データを変数に代入
dataAry(0) = ComboBox部署.Value
dataAry(1) = TextBox利用開始日.Value
dataAry(2) = TextBoxPC分類.Value
dataAry(3) = TextBox引当PC.Value
dataAry(4) = ComboBox使用分類.Value
dataAry(5) = TextBoxpage1備考.Value

strTO = Range("D3").Value '宛先アドレス
strCC = Range("E3").Value ' CCアドレス
strBCC = Range("F3").Value 'BCCアドレス
strSubject = Range("G3").Value 'タイトル文
strBody = Range("H3") '本文
'main
Application.ScreenUpdating = False
With Cells(Rows.Count, "BC").End(xlUp)
If Range("BC7").Value = "" Then
Range("B7").Value = TextBox氏名.Value
Range("BC7").Resize(, 6).Value = dataAry
Else
.Offset(1, -53).Value = TextBox氏名.Value　'BC -53 B列
.Offset(1).Resize(, 6).Value = dataAry
End If
End With
'Becky! 2は無いので未検証
Shell "C:\Program Files (x86)\RimArts\B2\B2.exe mailto:" _
& strTO & "?cc=" & strCC & "?bcc=" & strBCC & "?subject=" & strSubject & "?body=" & strBody, vbNormalFocus

Application.ScreenUpdating = True
Unload 登録foam

End Sub

Private Sub TextBox氏名_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If TextBox氏名.Value <> "" Then
If Application.CountIf(Range("B:B"), TextBox氏名.Value) > 0 Then
MsgBox ("対象者が重複しています")
Cancel = True
Exit Sub
End If
End If
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If TextBox氏名.Value <> "" Then TextBox氏名.Value = ""
End Sub

Public Function CHK_Val(strMsg As String)
If TextBox氏名.Value = "" Then strMsg = "氏名" & vbCrLf
If ComboBox使用分類.Value = "" Then strMsg = strMsg & "使用分類" & vbCrLf
If ComboBox部署.Value = "" Then strMsg = strMsg & "部署" & vbCrLf
If TextBox利用開始日.Value = "" Then strMsg = strMsg & "利用開始日" & vbCrLf
If TextBoxPC分類.Value = "" Then strMsg = strMsg & "分類" & vbCrLf
If TextBo引当PC.Value = "" Then strMsg = strMsg & "引当PC" & vbCrLf
CHK_Val = strMsg
End Function

No.5 回答者： Qchan1962 回答日時： 2021/08/22 22:14

#4です

vbNormalFocusocus　が気になったので　
Shell　コードを確認すると・・・
RimArtsB2B2　なのかな？　\RimArts\B2\B2　では、、、
実際のB2.exe のアドレスは分かりませんが、、実際のものに。
少なくともFiles (x86)RimArtsは無いのではと、、、

vbNormalFocusocus、、これはvb　なのでvbNormalFocus　かと
（ベッキー）自体知らないので、、あとは分かりませんが追記します。

No.4 回答者： Qchan1962 回答日時： 2021/08/22 21:12

こんばんは

直接の回答にならないと存じますが、
タイプミスもあるようなので、現段階で修正した方が良いと思う点と確認を

先ず、
＞シート上にあるユーザーフォームを使い
①これは、シート上のボタンからユーザーフォームを呼び、、と言う意味で良いでしょうか？

②各テキストボックスなどはユーザーフォーム上に作られているもので良いですか。

Sub フォーム起動_Click()
登録foam.Show
End Sub

③これは、シートモジュールに記載しているで良いでしょうか？

Private Sub page1登録_Click()
④これは、フォームモジュール（登録foam）に記載しているで良いでしょうか？

コードについて、

空白チェック、重複チェックは、合った場合、実行しないのですから
IFは閉じた方がわかり易いと思います。（メイン処理に移行させない）

下記サンプル
Private Sub page1登録_Click()
If TextBox氏名.Value = "" _
Or ComboBox使用分類.Value = "" _
Or ComboBox部署.Value = "" _
Or TextBox利用開始日.Value = "" _
Or TextBoxPC分類.Value = "" _
Or TextBo引当PC.Value = "" Then
MsgBox "未入力箇所があります"
Exit Sub　'page1登録_Clickをここで実行終了
End If

If WorksheetFunction.CountIf(Range("B:B"), TextBox氏名.Value) > 0 Then
MsgBox ("対象者が重複しています")
Exit Sub
End If

'更新画面の停止
Application.ScreenUpdating = False
・
・
Exit Sub　としてもユーザーフォームは閉じられません。

空白チェックは、どこが未入力か分からいとせっかくのUIがもったいないので、こんな書き方もあります

If TextBox氏名.Value = "" Then strMsg = "氏名" & vbCrLf
If ComboBox使用分類.Value = "" Then strMsg = strMsg & "使用分類" & vbCrLf
If ComboBox部署.Value = "" Then strMsg = strMsg & "部署" & vbCrLf
If TextBox利用開始日.Value = "" Then strMsg = strMsg & "利用開始日" & vbCrLf
If TextBoxPC分類.Value = "" Then strMsg = strMsg & "分類" & vbCrLf
If TextBo引当PC.Value = "" Then strMsg = strMsg & "引当PC" & vbCrLf
If strMsg <> "" Then
MsgBox "未入力箇所" & vbCrLf & strMsg & "を入力してください"
Exit Sub
End If

ここまでは、書き方の問題なのでスタックの原因であるかは分かりません。

あと、メール（ベッキー）は分かりませんが

strBody = Range("H3:M3") '本文
このセルは結合されているのでしょうか、、.Valueが取得できないような気がします。

Shell が問題があるのなら、メール（ベッキー）の使用を確認する必要があると思いますね。

①②③④の一部は、すでにご質問文にありますが、念のため。

No.3 回答者： めぐみん_ 回答日時： 2021/08/22 18:45

If WorksheetFunction.CountIf(range("B:B"),TextBox氏名) > 0 Then

かな？

でもフリーズするのはここが原因とは思えないです。

End If

Stop '追加してみて前半でフリーズするのかを調べてみる。
'問題なければ中断から進めて後半でフリーズするのか否か？？？

Sheets("TBL_2021年度").Select

No.2 回答者： めぐみん_ 回答日時： 2021/08/22 16:34

少なくとも未入力箇所がなければ、

＞If Range("B:B").Value = TextBox氏名 Then

ここでエラーになって止まると思いますけど？

No.1 回答者： くんこば 回答日時： 2021/08/22 14:33

ステップ実行してみてください。