Solved: Multiple messages boxes

[Rob342]

Hi
I have some code thatchecks on certain inputs and if the data input is either the same or the 1st 5 chars are the same what i would like is to have 2 or more messages boxes if the user enters the same data.
Here is where i am at the moment - with some help from you guys.
RTS checks on the 1st 5 chars and if there is a duplicate then to display the 1st message box.
RTS1 checks on the last char of the input to see if it is duplicated
Dups checks on the whole of the input( all chars entered.

[vba]
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Dups As Long
Dim RTS As Long
'Dim RTS1 As Long
If Not Block Then
If Target.Areas.Count > 1 Then Exit Sub
With Me.Range("B30:B45")
RTS = Evaluate("SumProduct(--(Left(B30:B45,5)=Left(" & Target(1, 1).Address & ",5)))")
'RTS1 = Evaluate("SumProduct(--(Mid(B30:B45,6,1)=Mid(" & Target(1, 1).Address & ",6,1)))")
Dups = Application.WorksheetFunction.CountIf(Me.Range("B30:B45"), Target(1, 1).Value)
If Dups > 1 Or RTS > 1 Then
If MsgBox("RTS Code Or Process Duplicated Please Check Process No ! _
Are You Really Sure You Want To Accept The Duplicate ?", vbYesNo) = vbYes Then
ActiveCell.Offset(1, 0).Select
End If
End If
End With
End If
End Sub
[/vba]

[Bob Phillips]

So you want 2 mor MsgBox? Although that seems odd, surely it is simple enough to add 2 more to that code, you already test the condition.

[Rob342]

Hi XLD
It would be nice to have a message box for each of the coditions, most of the code was done no by & simon,pcal45 as iam am still a newbie to VBA, or can you point me in the right direction.

[Bob Phillips]

Do you mean one if Dup > 1 AND RTS > 1, another when Dup >1 and RTS <=1, and 1 for Dup <= 1 and RTS > 1?

[Rob342]

XLD
the check sequence is complicated !! to say the least.
Dups chks whether the whole of the value entered is the same for example (user input = 79BAA1 and then uses the same value on another cell) this should generate 1 message box
RTS chks on the 1st 5 chars to see whether they are the same as previous eg 79BAA but the user can have a end char of 8 only,
this would generate another mess box.
RTS 1 will chk whether the last char is the same as the previous input ie 79BAA4 and 79BAA4 which is not allowed.
Then we would have a 4th situation where the user can enter 79BAA3 up to a maximun of 3 times, then produce a mess box saying maximum allowed = 3.
Hope you can understand this or whether its actually possible to do all these chks and produce the message boxes as req.Or would it be better to use select case and test for every occurrence and where would it go ?

[Bob Phillips]

I am not sure I fully understand all of that, but you wshould be able to work with this

[vba]

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Dups As Long
Dim RTS As Long
'Dim RTS1 As Long

If Not Block Then

If Target.Areas.Count > 1 Then Exit Sub

With Me.Range("B30:B45")

RTS = Evaluate("SumProduct(--(Left(B30:B45,5)=Left(" & Target(1, 1).Address & ",5)))")
'RTS1 = Evaluate("SumProduct(--(Mid(B30:B45,6,1)=Mid(" & Target(1, 1).Address & ",6,1)))")
Dups = Application.WorksheetFunction.CountIf(Me.Range("B30:B45"), Target(1, 1).Value)
Select Case True

Case Dups > 1 And RTS > 1

If MsgBox("RTS Code And Process Duplicated. Please Check Process No !" & vbNewLine & _
"Are You Really Sure You Want To Accept The Duplicate ?", vbYesNo) = vbYes Then

ActiveCell.Offset(1, 0).Select
End If

Case Dups > 1

If MsgBox("Process Duplicated. Please Check Process No !" & vbNewLine & _
"Are You Really Sure You Want To Accept The Duplicate ?", vbYesNo) = vbYes Then

ActiveCell.Offset(1, 0).Select
End If

Case RTS > 1

If MsgBox("RTS CodeDuplicated. Please Check Process No !" & vbNewLine & _
"Are You Really Sure You Want To Accept The Duplicate ?", vbYesNo) = vbYes Then

ActiveCell.Offset(1, 0).Select
End Select
End With
End If
End Sub
[/vba]

[Rob342]

Hi XLd
I try the code and get back to you thanks.

[Rob342]

Hi xld

Code wont compile, errors with message "End select without Select Case"

[Bob Phillips]

Missing E nd If

[vba]

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Dups As Long
Dim RTS As Long
'Dim RTS1 As Long

If Not Block Then

If Target.Areas.Count > 1 Then Exit Sub

With Me.Range("B30:B45")

RTS = Evaluate("SumProduct(--(Left(B30:B45,5)=Left(" & Target(1, 1).Address & ",5)))")
'RTS1 = Evaluate("SumProduct(--(Mid(B30:B45,6,1)=Mid(" & Target(1, 1).Address & ",6,1)))")
Dups = Application.WorksheetFunction.CountIf(Me.Range("B30:B45"), Target(1, 1).Value)
Select Case True

Case Dups > 1 And RTS > 1

If MsgBox("RTS Code And Process Duplicated. Please Check Process No !" & vbNewLine & _
"Are You Really Sure You Want To Accept The Duplicate ?", vbYesNo) = vbYes Then

ActiveCell.Offset(1, 0).Select
End If

Case Dups > 1

If MsgBox("Process Duplicated. Please Check Process No !" & vbNewLine & _
"Are You Really Sure You Want To Accept The Duplicate ?", vbYesNo) = vbYes Then

ActiveCell.Offset(1, 0).Select
End If

Case RTS > 1

If MsgBox("RTS CodeDuplicated. Please Check Process No !" & vbNewLine & _
"Are You Really Sure You Want To Accept The Duplicate ?", vbYesNo) = vbYes Then

ActiveCell.Offset(1, 0).Select
End Select
End If
End With
End If
End Sub
[/vba]

[Rob342]

Hi XLD
I have put 2 End IF in the code One after the last Case Statement
All working ok now, I think i can go on now & add some more chks to it
Once again thanks for your help, I will mark it as solved.