Solved: function to extract chars from string using VBA

[Rob342]

Hi

I am trying to extract the first 5 & 6 chars from a string in a cell to test various 6th digit chars.Using the left & mid function
If i use left(B30,6) this works fine directly in a cell but doesn't work in VBA
I have tried using VBA debug but the value always comes back as "".
The code i have works fine for picking up duplicates but i want to extract & do tests on the 1st 5 & especially the 6th char from the string ?
Here is the code i have with help from you guys, simon,xld.p45cal


Private Sub Worksheet_Change(ByVal Target As Range)
Dim Dups As Long
Dim RTS As Long
Dim RTS1 As Long
Dim RTS2 As Long
If Not Block Then
If Target.Areas.Count > 1 Then Exit Sub

With Me.Range("B30:B45")
Dups = Application.WorksheetFunction.CountIf(Me.Range("B30:B45"), Target(1, 1).Value)
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)))")
'RTS2 = RTS + RTS1
Select Case True

Case Dups > 1
' Check for complete duplicate of sro number
If MsgBox("RTS Code And Process Duplicated. Only A Process 3 Duplicate Is Allowed !" & vbNewLine & _
"Are You Really Sure You Want To Accept The Duplicate ?", vbYesNo) = vbYes Then
ActiveCell.Offset(1, 0).Select
End If

Case RTS > 1
' RTS check if 1st 5 chars are the same
If MsgBox("1st 5 Chars Of RTS Code Duplicated - Only A Process 3 Duplicate Is Allowed ! . Please Delete This Line !" & vbNewLine & _
"And Re-Enter A Different RTS Code ?", vbYesNo) = vbYes Then

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

Case RTS > 1 And RTS1 > 1
' RTS check if 1st 5 chars are the same and RTS1 6th char is the same !
If MsgBox("RTS Code & Process Duplicated - Different Vehicles ! . Please Delete This Line !" & vbNewLine & _
"And Re-Enter A Different RTS Code ?", vbNo) = vbNo Then

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

Case RTS2 > 1
' check if the 6th digit is the same as other input values
If MsgBox("RTS Code 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
End Select
End With
End If
End Sub

[mdmackillop]

Hi Rob.
When you post code, use the green VBA button to format it as shown.
Can you post a workbook with some sample data?

[mikerickson]

Select Case executes the first Case that evaluates to True. Therefore,Case RTS > 1 And RTS1>1 should precede both Case RTS > 1 and Case RTS1 > 1 .

[Rob342]

Hi md
Sorry didn't see the vba button will remember next time.
Zip file attatched, please ignore all the rubbish on there as this a test copy.
The code works as far as obtaining dups but there are certain rts codes where the user can select for example 79AAA3 on 3 diff lines and this is acceptable, but if the user selects 79AAA1 this can only be selected once.
So everthing revolves around the process no ie 6th digit.
If you select from the drop down on B30 79AAA1 ( b31 is reserved for auto calc on process 3.
If you then select from B32 a rts code 79AAA1 it will show the box with dups.
But you can have 79BAA2 on 1 line & 79BAA8 on another which is allowed.
Its a complicated process !!

[mdmackillop]

I'll check it out tomorrow.