VBA ARRAY CODE HELP

[roykana]

Dear all master,
Please help for vba array code remove numbers based on specific contents of cell.

ORIIGINAL

RESULT

So remove the numbers based on the contents of the word "KANA".


Thanks

roykana

 

[Peter_SSs]

Can't you spot him/her a little extra time?

No, it is not an individual setting but a board-wide setting by member level.
BTW, the somewhat unpleasant back-and-forward between you and the OP about posting technique has arisen because you have not followed #9 of the Forum Rules, so please follow that in the future.

@roykana
See if this resolves both the formatting issue and the multiple texts issue. There should be no need to call a routine multiple times even if this doesn't meet your needs.
I have assumed that these text strings that you are looking for will always be the first text in the cell. If this is not the case, please give some more samples and explanation.

Sub Replace_Values()
  Dim RX As Object
  Dim a As Variant
  Dim i As Long

  Set RX = CreateObject("VBScript.RegExp")
  RX.IgnoreCase = True
  RX.Pattern = "^(kana|budi|joko)(.+)( \d*)$" '<- You can add more text values separated by "|"
  With ActiveSheet.ListObjects(1).ListColumns(1).DataBodyRange
    a = .Value2
    For i = 1 To UBound(a)
      a(i, 1) = RX.Replace(a(i, 1), "$1$2")
    Next i
    .Value = a
  End With
End Sub

 

[jolivanes]

You are right. I should not comment on how other people post. I should take a lesson from one of the gurus that just don't answer posts anymore where people do this.
I am guilty of wanting to see a clutter free environment and unfortunately I cannot see any reason why a post with 60+ lines should be repeated in the very next post. But that's just me.
In my opinion, it is akin to someone telling me that I am stupid and probably don't know what I suggested one post previously.
But hey, storage is not at a premium anymore so we'll just continue on.

BTW, thanks for hyperlinking to the rules section. Previously I have attempted to find a "Rules" section but I was never able to find it.
My answer to Fluff was just meant as a tongue in cheek remark. Apparently a poor decision.
My apologies Peter.

 

[Peter_SSs]

My apologies Peter

No problem.

I am guilty of wanting to see a clutter free environment and unfortunately I cannot see any reason why a post with 60+ lines should be repeated in the very next post. But that's just me.

No, it isn't just you but it is hard to teach/get people to 'mini-quote' like I have here, or refer generally to a post by number as you suggested. At least when a long quote is inserted, the forum software hides most of it from the viewer & you don't have that much clutter - unless you 'Click to expand ...'

Apart from the rules, other useful information can be found from the main forum page

 

[Tom.Jones]

That was rude...

Peter,
what does that SS mean in your name?
I hope it's not about that SS, Nazi ...
I have bad memories of the Nazi scoundrels in the SS
When I see that "SS" sign, I feel sick.

 

[Peter_SSs]

Peter,
what does that SS mean in your name?

It is not SS, it is actually SSs and it is an abbreviation of a project name at my then workplace when I first joined MrExcel to ask a question related to that project.

 

[roykana]

No, it is not an individual setting but a board-wide setting by member level.
BTW, the somewhat unpleasant back-and-forward between you and the OP about posting technique has arisen because you have not followed #9 of the Forum Rules, so please follow that in the future.

@roykana
See if this resolves both the formatting issue and the multiple texts issue. There should be no need to call a routine multiple times even if this doesn't meet your needs.
I have assumed that these text strings that you are looking for will always be the first text in the cell. If this is not the case, please give some more samples and explanation.

Sub Replace_Values()
  Dim RX As Object
  Dim a As Variant
  Dim i As Long

  Set RX = CreateObject("VBScript.RegExp")
  RX.IgnoreCase = True
  RX.Pattern = "^(kana|budi|joko)(.+)( \d*)$" '<- You can add more text values separated by "|"
  With ActiveSheet.ListObjects(1).ListColumns(1).DataBodyRange
    a = .Value2
    For i = 1 To UBound(a)
      a(i, 1) = RX.Replace(a(i, 1), "$1$2")
    Next i
    .Value = a
  End With
End Sub

Dear Mr. Peter_SSs,
Sorry I'm late to you. Thank you very much for your reply
it runs perfectly. You are indeed a master and I want to learn a lot from you.

as per your explanation that the code runs if the text is in the first. if the searched text is in the first, middle and last part, what is the vba code?

One line of code use trim so I can comment or uncomment as per my need.

Thanks
roykana

 

[jolivanes]

Re: "You are indeed a master and I want to learn a lot from you." in Post #26.
Sorry Peter, maybe I still have a slight chance to be included in this exclusive club!

Sub Strip_Number()
Dim c As Range
    For Each c In Sheets("Sheet1").Range("A2:A" & Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row)
        If InStr(c, "KANA") <> 0 Then
            c.Value = StripNumber(c.Value)
        End If
    Next c
End Sub

Function StripNumber(stdText As String)
    Dim str As String, i As Integer
    stdText = Trim(stdText)
    For i = 1 To Len(stdText)
        If Not IsNumeric(Mid(stdText, i, 1)) Then
            str = str & Mid(stdText, i, 1)
        End If
    Next i
    StripNumber = str
End Function

 

[Peter_SSs]

if the searched text is in the first, middle and last part, what is the vba code?

One line of code use trim so I can comment or uncomment as per my need.

See how this goes. (All the digits can be removed at once, rather than checking one character at a time)
As requested (I think) I have provided two choices about how the digit replacements are treated. Use one of those commented lines or the other, not both together.

Sub Replace_Values_v2()
  Dim RX As Object
  Dim a As Variant
  Dim i As Long
  
  Const Pat1 As String = "kana|budi|joko" '<- You can add more text values separated by "|"
  Const Pat2 As String = "\d"

  Set RX = CreateObject("VBScript.RegExp")
  RX.Global = True
  RX.IgnoreCase = True
  With ActiveSheet.ListObjects(1).ListColumns(1).DataBodyRange
    a = .Value2
    For i = 1 To UBound(a)
      RX.Pattern = Pat1
      If RX.test(a(i, 1)) Then
        RX.Pattern = Pat2
        a(i, 1) = RX.Replace(a(i, 1), " ")  '<- Use this line to replace digits with a space character per post 26 result samples
'        a(i, 1) = Application.Trim(RX.Replace(a(i, 1), ""))  '<- Use this line instead of the above to eliminate excess spaces in the result
      End If
    Next i
    .Value = a
  End With
End Sub

 

[roykana]

Re: "You are indeed a master and I want to learn a lot from you." in Post #26.
Sorry Peter, maybe I still have a slight chance to be included in this exclusive club!

Sub Strip_Number()
Dim c As Range
    For Each c In Sheets("Sheet1").Range("A2:A" & Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row)
        If InStr(c, "KANA") <> 0 Then
            c.Value = StripNumber(c.Value)
        End If
    Next c
End Sub

Function StripNumber(stdText As String)
    Dim str As String, i As Integer
    stdText = Trim(stdText)
    For i = 1 To Len(stdText)
        If Not IsNumeric(Mid(stdText, i, 1)) Then
            str = str & Mid(stdText, i, 1)
        End If
    Next i
    StripNumber = str
End Function

Dear Mr. jolivanes,

Thank you for your reply, I appreciate your efforts.
thanks
roykana

 

[roykana]

See how this goes. (All the digits can be removed at once, rather than checking one character at a time)
As requested (I think) I have provided two choices about how the digit replacements are treated. Use one of those commented lines or the other, not both together.

Sub Replace_Values_v2()
  Dim RX As Object
  Dim a As Variant
  Dim i As Long
 
  Const Pat1 As String = "kana|budi|joko" '<- You can add more text values separated by "|"
  Const Pat2 As String = "\d"

  Set RX = CreateObject("VBScript.RegExp")
  RX.Global = True
  RX.IgnoreCase = True
  With ActiveSheet.ListObjects(1).ListColumns(1).DataBodyRange
    a = .Value2
    For i = 1 To UBound(a)
      RX.Pattern = Pat1
      If RX.test(a(i, 1)) Then
        RX.Pattern = Pat2
        a(i, 1) = RX.Replace(a(i, 1), " ")  '<- Use this line to replace digits with a space character per post 26 result samples
'        a(i, 1) = Application.Trim(RX.Replace(a(i, 1), ""))  '<- Use this line instead of the above to eliminate excess spaces in the result
      End If
    Next i
    .Value = a
  End With
End Sub

Dear Mr. Peter_SSs,
It's perfect and runs really fast. You are truly a master and let me learn from you and make you as my teacher.

May I ask for recommendations for links that can master vba array code and VBScript.

Thanks
roykana