View Full Version : Solved: VBA Help Remove first Character
Emoncada
08-08-2011, 08:31 AM
I have the following code that works, but has 1 problem.
Option Explicit
Sub RemoveS()
Dim c As Range
Application.ScreenUpdating = False
For Each c In Range("D3", Range("D" & Rows.Count).End(xlUp))
If Left(c, 1) = "S" Then c = Right(c, Len(c) - 1)
If Left(c, 2) = "*S" Then c = Right(c, Len(c) - 2)
Next c
Application.ScreenUpdating = True
End Sub
I need it to run just once, but this code does "Next c" so I am assuming it keeps looping.
I just want it to remove the First "S" if found and leave everything else as is.
If it starts with a "*S" then I want it to remove that and leave everything else as is.
It works but if the cell has a "SS" it removes both instead of just the first "S".
Any advise?
Aflatoon
08-08-2011, 08:38 AM
I cannot see anything in that code that would remove an SS - it should only remove the first S, unless you actually ran the code twice.
ammage
08-08-2011, 10:01 AM
I am not sure why your code does not work.
When the word starts with "*S", such as the string "ASKED", do you want to remove both the A and the S (leaving "KED") or just the S (leaving AKED)?
The following code will remove just the first S if the word starts with "SS" but in all other cases where the S is the second character, it will remove the first two characters.
I hope my understanding of what you are trying to do was correct.
Sub RemoveS()
Dim c As Range
Application.ScreenUpdating = False
For Each c In Range("D3", Range("D" & Rows.Count).End(xlUp))
If Left(c, 1) = "S" Then
c = Right(c, Len(c) - 1)
ElseIf Left(c, 2) Like "*S" Then
c = Right(c, Len(c) - 2)
End If
Next c
Application.ScreenUpdating = True
End Sub
Paul_Hossler
08-08-2011, 10:10 AM
I think it should have a .Cells
For Each c In Range("D3", Range("D" & Rows.Count).End(xlUp)).Cells
Paul
Emoncada
08-08-2011, 10:18 AM
Ok I realized why it's doing that.
I have this active worksheet change to change to Uppercase
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Or Target.HasFormula Then Exit Sub
On Error Resume Next
If Not Intersect(Target, Range("D3:D1000")) Is Nothing Then
Application.EnableEvents = False
Target = UCase(Target)
Application.EnableEvents = True
Call RemoveS
End If
On Error GoTo 0
End Sub
Which then calls RemoveS Macro.
Any way I can have this happen on Worksheet change ?
Kenneth Hobs
08-08-2011, 10:27 AM
Move the Enable Events code = True to after the Call.
Emoncada
08-08-2011, 10:32 AM
Ok, that kind of works but, what it does it it checks the range instead of the cell that changed.
so if D5 = "SS12345" it changed to "S12345" which is good, but
when D6 = "S987654" it goes back and removes D5's current "S"
Do you know what i mean?
Is it possibly instead of worksheet_change which will test after any change to the active cell ?
Paul_Hossler
08-08-2011, 10:42 AM
I'd do something like this
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rData As Range, rCell As Range
With ActiveSheet
Set rData = Range(.Cells(3, 4), .Cells(.Rows.Count, 4).End(xlUp))
End With
Set rData = Intersect(Target, rData)
If rData Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False
For Each rCell In rData.Cells
With rCell
If Not .HasFormula Then
.Value = UCase(.Value)
If Left(.Value, 1) = "S" Then .Value = Right(.Value, Len(.Value) - 1)
If Left(.Value, 2) = "*S" Then .Value = Right(.Value, Len(.Value) - 2)
End If
End With
Next
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
I didn't see a need to restrict it to a single cell, since you might copy / paste a group
Paul
Kenneth Hobs
08-08-2011, 10:46 AM
I don't see why you need to call a Sub in that case. If you do, add this to a Module:
Sub RemoveS1(c As Range)
If Left(c, 1) = "S" Then c = Right(c, Len(c) - 1)
If Left(c, 2) = "*S" Then c = Right(c, Len(c) - 2)
End Sub
For the change event:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim iRange As Range
If Target.Cells.Count > 1 Or Target.HasFormula Then Exit Sub
Set iRange = Intersect(Target, Range("D3:D1000"))
If iRange = Nothing Then Exit Sub
Application.EnableEvents = False
Target.Value = UCase(Target)
RemoveS1 Target
Application.EnableEvents = True
End Sub
Emoncada
08-08-2011, 10:54 AM
Paul that worked. It did exactly what I needed. Thank you everybody for you assistence. I appreciate it.
Powered by vBulletin® Version 4.2.5 Copyright © 2025 vBulletin Solutions Inc. All rights reserved.