Search for and replace last X number of characters

**garden_gnome** · 01-27-2012, 04:54 PM

Hello All!
I am looking for a more robust code than a simple search and replace. I am working with part numbers that are of various length and format, yet I need to trim some characters off the pn.
The only constand thing is what I am taking off the end of the pn.
For example: 123ABC789-LF I need to make this 123ABC789. However, some of my pn's may have the text that I want to replace in the middle of the pn. Example: 123AB-C789-C needs to be 123AB-C789. I can not do a simple search and replace because it will turn that into 123AB789. I also can not do a slightly more complex REPLACE function because the pn's vary in lenght.
I have a few things I am looking to eliminate off the end of the part numbers, so it needs to loop through until it does not find anything more. Or it needs to loop through each cell in the selection one by one and eleminate text.
Here is the simple search and replace macto that I currently have. It will have all the text that I need to replace.

Private Sub Strip_PN()
'
MsgBox ("This Macro will Auto Delete the Customer Prefix and the following Suffixes: -LF, -MN, -M0*, and -C" & Chr(13) & Chr(13) & _
    "Please enter any specific Prefixes and Suffixes you wish to delete into the next two input boxes.")

Dim prefix As String
Dim suffix As String
Dim MyStr, Default
MyStr = Cells(2, 3)
Default = (Left(MyStr, 3))

prefix = UCase(Trim(InputBox("Enter Customer Prefix to Delete", "Prefix for Each Cell", Default)))
suffix = UCase(Trim(InputBox("Enter Optional Suffix to Delete" & Chr(13) & Chr(13) & "Leave blank if NO Optional Suffix needed!", "Suffix for Each Cell")))

Selection.Replace What:=prefix, Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
Selection.Replace What:=suffix, Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
Selection.Replace What:="-LF", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
Selection.Replace What:="-MN", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
Selection.Replace What:="-M0*", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
Selection.Replace What:="-C", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
'
End Sub

Thanks for all your help in advance!

**Steffen Thomsen** · 01-27-2012, 05:09 PM

Is it possible to do something like this?

Sub steffen
For each cell in range("A1:A10")
     if instr(1, cell.value, "-LF") > 0 then
         ' Do replace for -LF type strings
     elseif instr(1,cell.value, "-MN") > 0 then
         ' Do replace for -MN type string
     end if
next cell
End sub

This method only works if the different constants have the same structure.

If you cant take this approach then try uploading a sample workbook wit the different cases.

**pike** · 01-28-2012, 05:15 AM

hmmm.. the replace will be faster than looping

but what prefix do you delete?

and are all double suffix's to be deleted?

Option Explicit
Private Sub Strip_PN()
Dim prefix As String
Dim suffix As String
Dim MyStr, Default
Dim rng As Range
Application.ScreenUpdating = False

MsgBox ("This Macro will Auto Delete the Customer Prefix and the following Suffixes: -LF, -MN, -M0*, and -C" & Chr(13) & Chr(13) & _
    "Please enter any specific Prefixes and Suffixes you wish to delete into the next two input boxes.")



MyStr = Cells(2, 3)
Default = (Left(MyStr, 3))

prefix = UCase(Trim(InputBox("Enter Customer Prefix to Delete", "Prefix for Each Cell", Default)))
suffix = UCase(Trim(InputBox("Enter Optional Suffix to Delete" & Chr(13) & Chr(13) & "Leave blank if NO Optional Suffix needed!", "Suffix for Each Cell")))
Set rng = Range("A1", Cells(Rows.Count, 1).End(xlUp))
With rng
If Not IsEmpty(prefix) Then
If Not InStr(1, prefix, "-") > 0 Then
  prefix = prefix & "-"
  End If
.Replace What:=prefix, Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    End If
  If Not IsEmpty(suffix) Then
  If Not InStr(1, suffix, "-") > 0 Then
  prefix = "-" & suffix
  End If
 .Replace What:=suffix, Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    End If
.Replace What:="-LF", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
.Replace What:="-MN", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
.Replace What:="-M0*", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
.Replace What:="-C", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
End With
Application.ScreenUpdating = False

End Sub