Displaying message box on correct entry as well but it should not

**excel_126** · 12-16-2014, 01:04 PM

Dear All,

I have two excel vba forms in which data is entered through second form in excel workbook. The second form has varioys combination like one can add reports with finance and hr as well. Also, one can add slide sets with finance and hr as well. But none of the same combination can not be reported in sheet. I am using the following code for adding data

Option Explicit
Private mChks As Collection
Public Sub SingleCheck(Name As String)

    Dim Chk As CChk
    
    For Each Chk In mChks
        If StrComp(Name, Chk.MyChk.Name, vbTextCompare) = 0 Then
            ' ignore
        Else
            Chk.MyChk.Value = False
        End If
    Next
        
End Sub


Private Sub ComboBox8_Change()
ComboBox7.Value = Sheet7.Range("B" & ComboBox8.ListIndex + 2)
ComboBox9.Value = Sheet7.Range("C" & ComboBox8.ListIndex + 2)

End Sub

Private Sub UserForm_Initialize()

    Dim Chk As CChk
    Dim ctl As MSForms.Control
    
    Set mChks = New Collection
    
    For Each ctl In Me.Controls
        If TypeOf ctl Is MSForms.CheckBox Then
            Set Chk = New CChk
            Set Chk.MyChk = ctl
            mChks.ADD Chk, CStr(mChks.Count + 1)
        End If
    Next
    
End Sub


Private Sub UserForm_Terminate()

    Do While mChks.Count > 0
        mChks.Remove 1
    Loop
    Set mChks = Nothing
    
End Sub

Private Sub CommandButton1_Click()
Dim ctrl As Control
For Each ctrl In Completetask.Controls
    If TypeName(ctrl) = "CheckBox" Then
    TransferValues ctrl
    End If
    Next
End Sub
   
Sub TransferValues(cb As MSForms.CheckBox)
Dim ws As Worksheet
Dim Response3 As VbMsgBoxResult
Dim emptyRow As Long
'Dim ID As String

If cb.Value = True Then
    Set ws = Sheets(Left(cb.Caption, 8))
        If Trim(Me.ComboBox3.Value) = "" Or Trim(Me.ComboBox6.Value) = "" Then
            MsgBox ("Please Enter the text in All Fields")
            Exit Sub
        End If
    emptyRow = WorksheetFunction.CountA(ws.Range("C:C")) + 1
      With ws
        If Not (WorksheetFunction.CountIf(ws.Range("C:C"), ComboBox3.Value) > 0 And WorksheetFunction.CountIf(ws.Range("D:D"), ComboBox6.Value) > 0) Then

        .Cells(emptyRow, 4).Value = ComboBox6.Value
        .Cells(emptyRow, 3).Value = ComboBox3.Value
        .Cells(emptyRow, 5).Value = TextBox1.Value
        '.Cells(emptyRow, 1).Value = ComboBox8.Value
        '.Cells(emptyRow, 2).Value = ComboBox7.Value
        '.Cells(emptyRow, 3).Value = ComboBox9.Value
        Response3 = MsgBox("Do you want to add more data", vbYesNo)
            If Response3 = vbYes Then
                ComboBox6.Value = Null
                ComboBox3.Value = Null
                TextBox1.Value = Null
            Else
                End If
        
        
        Else
            MsgBox ("Warning:Duplicate Entries Found. Please edit existing entries")
        End If

      End With
End If

End Sub

But I am getting message box of duplicate entries for the correct combination as well. Please help.

I have attached one demo file as well