Run time error 28

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
5,199
Office Version
  1. 2007
Platform
  1. 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.

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
 

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).
You aren't including a space when it's 6 characters so it's going into a permanent loop.
You will also need to disable events otherwise you will get 2 spaces rather than one if it's 6 characters.
 
Upvote 0
Well spotted thanks.

Do i change the True before it to False or do i need to add it ?
 
Upvote 0
Just move this line
VBA Code:
 Application.EnableEvents = True
to the end of the code.
 
Upvote 0
Ok now i have this which works without the error.
But when i type BS92HH it then adds 2 spaces so its BS9 2HH & not BS9 2HH
Is it me being fussy or did i do it wrong ?
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 = False
    
    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)
    Application.EnableEvents = True
    End If
    On Error GoTo 0
    Application.EnableEvents = True
End Sub
 
Upvote 0
You will need to do it like
VBA Code:
    If Len(Target) = 6 Then
      Target = Left(Target, 3) & " " & Right(Target, 3)
    ElseIf Len(Target) = 7 Then
      Target = Left(Target, 4) & " " & Right(Target, 3)
    End If
 
Upvote 0
Solution
I had to put an End If at the bottom but now none are spaced when adding the code above

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 = False
    
    If Target.Column = 4 Then
    On Error Resume Next
    If Len(Target) = 6 Then
      Target = Left(Target, 3) & " " & Right(Target, 3)
    ElseIf 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)
    Application.EnableEvents = True
    End If
    On Error GoTo 0
    Application.EnableEvents = True
    End If
End Sub
 
Upvote 0
You should just have replaced these two lines with the code I posted.
You now have the end if in the wrong place. It should be before the target.column=3
 
Upvote 0
Thanks,so this should now be correct

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 = False
    
    If Target.Column = 4 Then
    On Error Resume Next
    If Len(Target) = 6 Then
      Target = Left(Target, 3) & " " & Right(Target, 3)
    ElseIf Len(Target) = 7 Then
      Target = Left(Target, 4) & " " & Right(Target, 3)
    End If
    End If
    If Target.Column = 3 Then
    On Error Resume Next
    If Len(Target) = 11 Then Target = Left(Target, 5) & " " & Right(Target, 6)
    Application.EnableEvents = True
    End If
    On Error GoTo 0
    Application.EnableEvents = True
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,487
Messages
6,113,943
Members
448,534
Latest member
benefuexx

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top