Couple of problem(ettes) with that code, so I played with it some more
Private Sub Worksheet_Change(ByVal Target As Range)
Const kRange As String = "F2:F5000"
Const pcCityCodes As String = "BEGLMNSW"
Const pcNoSpaceZero1 As String = "[A-Z][A-Z]##[A-Z][A-Z]"
Const pcNoSpaceZero2 As String = "[A-Z]##[A-Z][A-Z]"
Const pcNoSpace1 As String = "[A-Z][A-Z]###[A-Z][A-Z]"
Const pcNospace2 As String = "[A-Z]###[A-Z][A-Z]"
Const pcNoZero1 As String = "[A-Z][A-Z]# #[A-Z][A-Z]"
Const pcNoZero2 As String = "[A-Z]# #[A-Z][A-Z]"
Const pcMajorCity As String = "[A-Z]## #[A-Z][A-Z]"
Const pcValid1 As String = "[A-Z][A-Z]## #[A-Z][A-Z]"
Const pcValid2 As String = "[A-Z]## #[A-Z][A-Z]"
Const pcCities As String = "Birmingham,East London,Glasgow,Liverpool,Manchester,North London,Sheffield,West London"
Dim sCode As String
Dim aryCities
Dim iPos As Long
aryCities = Split(pcCities, ",")
On Error GoTo ws_exit:
Application.EnableEvents = False
If Not Intersect(Target, Me.Range(kRange)) Is Nothing Then
With Target
sCode = UCase$(.Value)
'Missing space and leading zero
If sCode Like pcNoSpaceZero1 Then
sCode = Left$(sCode, 2) & "0" & Mid(sCode, 3, 1) & " " & Right$(sCode, Len(sCode) - 3)
ElseIf sCode Like pcNoSpaceZero2 Then
sCode = Left$(sCode, 1) & "0" & Mid(sCode, 2, 1) & " " & Right$(sCode, Len(sCode) - 2)
End If
'Missing zero only
If sCode Like pcNoZero1 Then
sCode = Left$(sCode, 2) & "0" & Right$(sCode, Len(sCode) - 2)
ElseIf sCode Like pcNoZero2 Then
sCode = Left$(sCode, 1) & "0" & Right$(sCode, Len(sCode) - 1)
End If
'Missing space only
If sCode Like pcNoSpace1 Then
sCode = Left$(sCode, 4) & " " & Right$(sCode, Len(sCode) - 4)
ElseIf sCode Like pcNospace2 Then
sCode = Left$(sCode, 3) & " " & Right$(sCode, Len(sCode) - 3)
End If
'test for major cities
If sCode Like pcMajorCity Then
'Major city code - need to confirm OK
iPos = InStr(1, pcCityCodes, Left(sCode, 1))
If iPos > 0 Then
If MsgBox("Can you confirm that " & sCode & " is a " & vbCrLf & _
aryCities(iPos - 1) & " postcode", vbYesNo, "PostCodes") = vbNo Then
MsgBox "Incorrect format: AA0# #AA", vbOKOnly, "PostCodes Error!"
End If
Else
MsgBox "Incorrect format: AA0# #AA", vbOKOnly, "PostCodes Error!"
End If
End If
'Now a final check
If (sCode Like pcValid1 Or sCode Like pcValid2) Then
'it's all ok
Else
MsgBox "Incorrect format: AA0# #AA", vbOKOnly, "PostCodes Error!"
'leave the string as-is so they can correct without
'retyping the whole thing
End If
.Value = sCode
End With
End If
ws_exit:
Application.EnableEvents = True
End Sub
#If VBA6 Then
#Else
'-----------------------------------------------------------------
Function Split(Text As String, _
Optional Delimiter As String = ",") As Variant
'-----------------------------------------------------------------
Dim i As Long
Dim sFormula As String
Dim aryEval
Dim aryValues
If Delimiter = vbNullChar Then
Delimiter = Chr(7)
Text = Replace(Text, vbNullChar, Delimiter)
End If
sFormula = "{""" & Application.Substitute(Text, Delimiter, """,""") & """}"
aryEval = Evaluate(sFormula)
ReDim aryValues(0 To UBound(aryEval) - 1)
For i = 0 To UBound(aryValues)
aryValues(i) = aryEval(i + 1)
Next
Split = aryValues
End Function
#End If
--
HTH
RP
(remove nothere from the email address if mailing direct)
Somebody has been messing with the code
This took more effort than I expected, but it works with my testing, I expect yours to be better
Private Sub Worksheet_Change(ByVal Target As Range)
Const kCities As String = "BEGLMNSW"
Dim sCode As String
Dim sExceptions
Dim iPos As Long
sExceptions = Array("Birmingham", "East London", "Glasgow", "Liverpool", _
"Manchester", "North London", "Sheffield", "West London")
On Error GoTo ws_exit:
Application.EnableEvents = False
If Not Intersect(Target, Me.Range("F2:F25000")) Is Nothing Then
With Target
sCode = UCase$(.Value)
'Sort out the embedded space
If (sCode Like "[A-Z][A-Z]###[A-Z][A-Z]" Or _
sCode Like "[A-Z][A-Z]##[A-Z][A-Z]") Then
sCode = Left$(sCode, 4) & " " & Right$(sCode, Len(sCode) - 4)
ElseIf (sCode Like "[A-Z]###[A-Z][A-Z]" Or _
sCode Like "[A-Z]##[A-Z][A-Z]") Then
sCode = Left$(sCode, 3) & " " & Right$(sCode, Len(sCode) - 3)
End If
'Sort out the leading zero
If sCode Like "[A-Z][A-Z]# #[A-Z][A-Z]" Then
sCode = Left$(sCode, 2) & "0" & Right$(sCode, Len(sCode) - 2)
ElseIf (sCode Like "[A-Z]# #[A-Z][A-Z]" Or _
sCode Like "[A-Z]##[A-Z][A-Z]") Then
sCode = Left$(sCode, 1) & "0" & Right$(sCode, Len(sCode) - 1)
End If
'test for major cities
If (sCode Like "[A-Z]## #[A-Z][A-Z]" Or _
sCode Like "[A-Z]###[A-Z][A-Z]" Or _
sCode Like "[A-Z]## [A-Z][A-Z]" Or _
sCode Like "[A-Z]##[A-Z][A-Z]") Then
'Major city code - need to confirm OK
iPos = InStr(1, kCities, Left(sCode, 1))
If iPos > 0 Then
If MsgBox("Can you confirm that " & sCode & " is a " & vbCrLf & _
sExceptions(iPos - 1) & " postcode", vbYesNo, "POstCodes") = vbNo Then
MsgBox "Incorrect format: AA0# #AA", vbOKOnly, "Error!"
End If
Else
MsgBox "Incorrect format: AA0# #AA", vbOKOnly, "Error!"
End If
End If
'Now a final check
If (sCode Like "[A-Z][A-Z]## #[A-Z][A-Z]" Or _
sCode Like "[A-Z]## #[A-Z][A-Z]") Then
'it's all ok
Else
MsgBox "Incorrect format: AA0# #AA", vbOKOnly, "Error!"
'leave the string as-is so they can correct without
'retyping the whole thing
End If
.Value = sCode
End With
End If
ws_exit:
Application.EnableEvents = True
End Sub
--
HTH
RP
(remove nothere from the email address if mailing direct)
I have been using the code below which is a very slight adaptation of Myrna's original recommendation. As Jamie, kindly pointed out there are 8 exceptions to the UK Postcode system which start with just one alpha character! I need to be able to let these pass through, so basically I need to allow both the following codes...
"[A-Z][A-Z]## #[A-Z][A-Z]"
and
"[A-Z]## #[A-Z][A-Z]"
The 8 Codes that break the rule a begin with the following...
B - Birmingham
E - East London
G - Glasgow
L - Liverpool
M - Manchester
N - North London
S - Sheffield
W - West London
Hope this makes sense? Maybe once they have put the postcode in maybe a dialog box can confirm that the address is indeed "Manchester?" for example...
One more point I need addressing is that the first part of the postcode is sometimes a single figure. I will need for the code to put in a 0(zero) to cover this... For example their post code maybe SW4 2AP I need the program to realise that in order to format correctly it needs to add a 0 i.e. the correct results would be SW04 2AP. This is due to the users only putting it in lazily and not fully understanding the postal coding system.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim X As String
On Error GoTo ws_exit:
Application.EnableEvents = False
If Not Intersect(Target, Me.Range("F2:F25000")) Is Nothing Then
With Target
X = UCase$(.Value)
If X Like "[A-Z][A-Z]0# #[A-Z][A-Z]" Then
'it's OK as is
ElseIf X Like "[A-Z][A-Z]0##[A-Z][A-Z]" Then
X = Left$(X, 4) & " " & Right$(X, 3)
Else
MsgBox "Incorrect format: AA0# #AA", vbOKOnly, "Error!"
'leave the string as-is so they can correct without
'retyping the whole thing
End If
.Value = X
End With
End If
ws_exit:
Application.EnableEvents = True
End Sub
Hope you guys or somebody else can help me on this one. I'm more used to using vb.net and VBA is turning me around and I don't want to conflict my thoughts.
Scott
