Remove prefix

[22strider]

Hello Friends

Could anyone please look at this part of the code that I am writing and let me know what am I doing wrong.

The code is supposed to copy prefix from the active cell and store it to the variable 'strPrefix'. The active cell values are in the format of 'xxx-yyyy' (of variable length ofcourse) and the code is supposed to look for dash "-" and get the string portion before the dash and store it to the variable.
So in my example the variable should get 'xxx' added to it.

strPrefix = Left(ActiveCell.Value, WorksheetFunction.Find("-", ActiveCell.Value, 1) - 1)

But when I run my code I am getting runtime error (debugging highlights this row) that "Unable to get the Find property of the WorksheetFunction class"

Thanks for your help
Rajesh

 

[Gary's Student]

Consider:

Sub dural()
strPrefix = Split(ActiveCell.Value, "-")(0)
MsgBox strPrefix
End Sub

So if the activecell contains:
abcde-qwerty

You will see:
abcde

 

[Rick Rothstein]

Hello Friends

Could anyone please look at this part of the code that I am writing and let me know what am I doing wrong.

The code is supposed to copy prefix from the active cell and store it to the variable 'strPrefix'. The active cell values are in the format of 'xxx-yyyy' (of variable length ofcourse) and the code is supposed to look for dash "-" and get the string portion before the dash and store it to the variable.
So in my example the variable should get 'xxx' added to it.

strPrefix = Left(ActiveCell.Value, WorksheetFunction.Find("-", ActiveCell.Value, 1) - 1)

But when I run my code I am getting runtime error (debugging highlights this row) that "Unable to get the Find property of the WorksheetFunction class"

That code line works for me; however, that is not how I would do it... I would rather make use of VB's built-in functions instead of calling out to the worksheet functions. You could either do it this way...

 strPrefix = Left(ActiveCell.Value, InStr(ActiveCell.Value, "-") - 1)

Or, alternately, do it this way.....

strPrefix = Split(ActiveCell.Value, "-")(0)

 

[22strider]

Hello Rick

Thanks for your message. INSTR function worked but then I realized a mistake and made a change and then it stopped working.
I have a list of prefixes. If the prefix before dash ("-") matches with those prefixes then I need to remove them; otherwise leave them alone. For this I created dictionary and added prefixes as Keys (rather than values) so that I could use "Exists" method of the dictionary.
I realized that I was using ActiveCell in the loop rather than Cells(). When I made this change I started getting "Application or Object defined error" on the following line

 strPrefix = Left(Cells(i, Lc).Value, InStr(Cells(i, Lc).Value, "-") - 1)

Following is my complete code

Sub RemovePrefix()

Dim strPrefix   As String

Dim Lr  As Long
Dim Lc  As Long
Dim i   As Long
Dim Prefix
Set Prefix = CreateObject("Scripting.Dictionary")

Prefix.Add "CZ", "a"
Prefix.Add "AD", "b"
Prefix.Add "PD", "c"
Prefix.Add "RN", "d"
Prefix.Add "GD", "e"
Prefix.Add "KD", "f"
Prefix.Add "KR", "g"
Prefix.Add "W", "h"
Prefix.Add "DVR", "i"
Prefix.Add "FP", "j"
Prefix.Add "TJ", "k"
Prefix.Add "TP", "l"
Prefix.Add "WP", "m"
Prefix.Add "BR", "n"
Prefix.Add "HS", "o"

Lc = ActiveCell.Column
Lr = Cells(ActiveSheet.Rows.Count, Lc).End(xlUp).Row

strPrefix = ""
For i = 0 To Lr Step 1

    
    
    
    strPrefix = Left(Cells(i, Lc).Value, InStr(Cells(i, Lc).Value, "-") - 1)
    
    If Prefix.Exists(strPrefix) Then
        ActiveCell.Value = Mid(Cells(i, Lc).Value, InStr(Cells(i, Lc), "-") + 1, Len(Cells(i, Lc).Value))
    End If
    
Next i

Prefix.RemoveAll

End Sub

Would it be possible to have a look and suggest me corrections?

Thanks
Rajesh

 

[Biz]

Nice 1 liner Rick.


Biz

 

[Biz]

Hi Rajesh,

Aren't you trying to remove items before "-"?

Does script before help?

[Sub DeleteWordTest()
Dim Cel As Range, Rng As Range
Dim Word As String
Set Rng = Range("A2:A5")
Word = "-"

Application.ScreenUpdating = False
For Each Cel In Rng
If Cel Like "*" & Word & "*" Then
Cel = Replace(Cel, (Left(Cel, Application.Find("-", Cel) - 1) & Word), "")
'To remove the double space that follows ..
Cel = Replace(Cel, " ", " ")
End If
Next Cel
Application.ScreenUpdating = True
End Sub/QUOTE]

Biz

 

[Biz]

Hi Rajesh,

Try function below

Function NoPrefixes(Text As String) As String
    Dim PreList As Variant
    Dim PreLen As Integer
    Dim TextLen As Integer
    Dim x As Byte
    
   Application.Volatile True
    PreList = Array("CZ", "AD", "PD", "RN", "GD", "KD", "KR", "W", "DVR", "FP", "TJ", "TP", "WP", "BR", "HS") 'You must complete this list
    TextLen = Trim(Len(Text))
    NoPrefixes = Text
    For x = 0 To UBound(PreList)
        PreLen = Len(PreList(x))
            If InStr(1, UCase(Left(Text, PreLen)), UCase(PreList(x))) Then
                NoPrefixes = Right(Text, TextLen - (PreLen + 1))
            End If
    Next x
End Function

Found was found HERE . If I am not wrong you asked this question earlier inSep 22nd, 2009.

Biz

 

[Rick Rothstein]

Rajesh, does this macre do what you want (activate any cell in the column you want to process before running it)...

Sub RemovePrefixes()
  Dim AddrRng As String
  AddrRng = Range(Cells(1, ActiveCell.Column), Cells(Rows.Count, ActiveCell.Column).End(xlUp)).Address
  Range(AddrRng) = Evaluate("=IF(" & AddrRng & "="""","""",IF(ISNUMBER(FIND(""*""&LEFT(" & AddrRng & ",FIND(""-""," & _
                            AddrRng & ")-1)&""*"",""*CZ*AD*PD*RN*GD*KD*KR*W*DVR*FP*TJ*TP*WP*BR*HS*"")),MID(" & _
                            AddrRng & ",FIND(""-""," & AddrRng & ")+1,99)," & AddrRng & "))")
End Sub

 

[Rick Rothstein]

Hi Rajesh,

Try function below

Function NoPrefixes(Text As String) As String
    Dim PreList As Variant
    Dim PreLen As Integer
    Dim TextLen As Integer
    Dim x As Byte
    
   Application.Volatile True
    PreList = Array("CZ", "AD", "PD", "RN", "GD", "KD", "KR", "W", "DVR", "FP", "TJ", "TP", "WP", "BR", "HS") 'You must complete this list
    TextLen = Trim(Len(Text))
    NoPrefixes = Text
    For x = 0 To UBound(PreList)
        PreLen = Len(PreList(x))
            If InStr(1, UCase(Left(Text, PreLen)), UCase(PreList(x))) Then
                NoPrefixes = Right(Text, TextLen - (PreLen + 1))
            End If
    Next x
End Function

Biz, I believe this one-liner UDF (I removed the Application.Volatile as the text in the cells must be constants since we are replacing parts of them and, hence, are not dependent on other cells) does the same thing as your UDF (note the argument change for String to Range)...

Function NoPrefixes(Rng As Range) As String
  NoPrefixes = Evaluate("IF(ISNUMBER(FIND(""*""&LEFT(" & Rng.Address & ",FIND(""-""," & Rng.Address & _
                        ")-1)&""*"",""*CZ*W*TJ*HS*"")),MID(" & Rng.Address & ",FIND(""-""," & Rng.Address & _
                        ")+1,99)," & Rng.Address & ")")
End Function

 

[22strider]

Hello Rick

I have no doubt that your code will work (you have helped me in the past as well) .

I am learning VBA and have stumbled my way of writing the code that I sent to you earlier. And I am not able to find out what mistake did I make there. would it be possible to point out what am I doing wrong here? This will help me learn.

Thanks a lot (one more time)
Rajesh