VBA to Count the number of times column B has an X

[gheyman]

I would like to add an If statement to the code below so that if column B does not have only one "X" in it the user gets a MsgBox

If there are 0 "X" = MsgBox "You must select one Proposal"
if there are more than one "X" then MsgBox "You can only select one Proposal. It appears that you have more then one selected"

Thank you for the help!

Sub ProposalName()

Dim lrow2 As Long, i As Long, iRow2

lrow2 = Worksheets("Step 1").Cells(Rows.Count, "B").End(xlUp).Row
iRow2 = 11
For i = 1 To lrow2
  If Cells(i, "B") = "X" Then
    
    Worksheets("Products").Range("A3") = "PL-" & Worksheets("Step 1").Cells(i, "C") & ", " & Worksheets("Step 1").Cells(i, "D")
    
    iRow2 = iRow2 + 1
  Else
  End If
Next i

End Sub

 

[gheyman]

Solved

Sub ProposalName()

Dim lrow2 As Long, i As Long, iRow2
Dim j As Long, Count As Long


lrow2 = Worksheets("Step 1").Cells(Rows.Count, "B").End(xlUp).Row
iRow2 = 11


'Count how many X's in Column B
For j = 1 To lrow2
    If Range("B" & j).Value = "X" Then
        Count = Count + 1
    End If
Next j


'if Column B only has the required  X
If Count = 1 Then

For i = 1 To lrow2
  If Cells(i, "B") = "X" Then
    
    Worksheets("Products").Range("A3") = "PL-" & Worksheets("Step 1").Cells(i, "C") & ", " & Worksheets("Step 1").Cells(i, "D")
    
    iRow2 = iRow2 + 1
  Else
  End If
Next i

Else
MsgBox "Check your Selections. You must select only one Proposal"

End If

End Sub

 

[smozgur]

I am not sure how the current code is supposed to work, because it looks like you expect it to be working with more than one X, however, the WorksheetFunction.CountIf function should help you with the question.

Dim foundX As Integer
foundX = Application.WorksheetFunction.CountIf(Range("B:B"), "X")

If foundX = 0 Then
    MsgBox "You must select one Proposal", vbOKOnly + vbInformation
    Exit Sub
ElseIf foundX > 1 Then
    MsgBox "You can only select one Proposal. It appears that you have more than one selected", vbOKOnly + vbInformation
    ' Exit Sub ' Assuming the rest of the code is supposed to be working even if there is more than one X exist.
Else
    ' Proceed
End If

 

[Herakles]

This code will prohibit entry of any character other than an X in column B.

If a second X is entered it is assumed that that is where the user wants it so deletes the existing X in the column.

Paste this code into the worksheet code module.

Let me know if you already have a Worksheet_Change event for this worksheet.

You don't really need the message telling the user that they have more than one X as they never will.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim intCountX As Integer
Dim intCountAll As Integer

    If Target.CountLarge > 1 Then
        Exit Sub
    End If
            
    If Not Intersect(Target, Range("B:B")) Is Nothing Then
    
        If Target.Row = 1 Then
            Exit Sub
        End If
    
        Application.EnableEvents = False
        Target.Value = UCase(Target.Value)
        If Target.Value <> "X" Then
            Target.Value = ""
        End If
        Application.EnableEvents = True
                        
        intCountX = Application.WorksheetFunction.CountIf(ActiveSheet.Range("B2:B" & ActiveSheet.Rows.Count), "X")
                
        Select Case intCountX
        
            Case 0:
                
                    MsgBox "You must select one Proposal.", vbOKOnly, "Warning!!"
                    
            Case Is > 1:
            
                    MsgBox "You can only select one Proposal." & vbCrLf & "It appears that you have more then one selected", vbOKOnly, "Warning!!"
            
                    Application.EnableEvents = False
                    ActiveSheet.Range("B2:B" & ActiveSheet.Rows.Count) = ""
                    Target.Value = "X"
                    Application.EnableEvents = True
                    
            Case Else
                                        
        End Select
        
        If Target.Value = "X" Then
        
            Worksheets("Products").Range("A3") = "PL-" & Worksheets("Step 1").Cells(Target.Row, "C") & ", " & Worksheets("Step 1").Cells(Target.Row, "D")
        
        End If
    
    End If
    
End Sub