ipbr21054
Well-known Member
- Joined
- Nov 16, 2010
- Messages
- 5,226
- Office Version
- 2007
- Platform
- Windows
Hi,
I am trying to use this code below but might need advice for something else as when i leave the cell in column D i see run time error 28 Out of stack space
The code for column C is to enter a space between 5 & 6 number, this works fine & doesnt pop up any errors.
The code for column D is to put a space in between a post code.
Post codes can be the following format
BS9 2HH & BS29 6HD so 3 characters followed by 3 characters & also 4 characters followed by 3 characters.
If i enter this format BS296HD i see it alter to BS29 6HD with no errors.
But if i enter this format BS92HH when i leave the cell the error appears.
Please advise many thanks.
I am trying to use this code below but might need advice for something else as when i leave the cell in column D i see run time error 28 Out of stack space
The code for column C is to enter a space between 5 & 6 number, this works fine & doesnt pop up any errors.
The code for column D is to put a space in between a post code.
Post codes can be the following format
BS9 2HH & BS29 6HD so 3 characters followed by 3 characters & also 4 characters followed by 3 characters.
If i enter this format BS296HD i see it alter to BS29 6HD with no errors.
But if i enter this format BS92HH when i leave the cell the error appears.
Please advise many thanks.
Rich (BB code):
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Dim cell As Range
Set rng = Intersect(Target, Range("A2:K" & Rows.Count))
' Exit if nothing entered into out target range
If rng Is Nothing Then Exit Sub
' Loop through all cells in our target range
Application.EnableEvents = False
For Each cell In rng
cell = UCase(cell)
Next cell
Application.EnableEvents = True
If Target.Column = 4 Then
On Error Resume Next
If Len(Target) = 6 Then Target = Left(Target, 3) & "" & Right(Target, 3)
If Len(Target) = 7 Then Target = Left(Target, 4) & " " & Right(Target, 3)
End If
If Target.Column = 3 Then
On Error Resume Next
If Len(Target) = 11 Then Target = Left(Target, 5) & " " & Right(Target, 6)
End If
On Error GoTo 0
End Sub