PDA

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.