0

So currently my VBA code looks like this:

Sub Testing()

Dim K As Long
Dim LR As Long
LR = Cells(Rows.Count, 1).End(xlUp).Row


For K = 2 To LR
   Cells(K, 2).Value = StripAfter(Cells(K, 1), "_", 6)
Next K

End Sub


Function StripAfter(ByVal txt As String, ByVal delimiter As String, ByVal 
  occurrence As Long) As String
    Dim x As Variant
    x = Split(expression:=txt, delimiter:=delimiter, limit:=occurrence + 1)

    StripAfter = x(UBound(x))
End Function

I have this linked to a button that will output the data like this: (Side note: Column A is pasted in, Column B is the result after having the VBA Macro run) Example

With this output it's exactly what the formula is made to do which is great! My question is and I can't wrap my head around this (I'm new with VBA Macros, trying to learn as best as I can) for the results in Column B, they all end in numbers with an X between the numbers. How would I adjust my code to make it so it deletes that portion of text? So the result would look like:

Example 2

As you can see from the results I'm looking for compared to the results that are given, the ###X### is taken out at the end. I've played around outside of VBA and found this to work but its essentially a two step process:

=RIGHT(SUBSTITUTE(A1,"_",CHAR(10),12),LEN(A1)-FIND(CHAR(10),SUBSTITUTE(A1,"_",CHAR(10),12),1)+1)

^^^ This will grab the last section of the string from A1 (First image)

=LEFT(A20,MIN(FIND({0,1,2,3,4,5,6,7,8,9},A20&"0123456789")) -1)

^^^ (A20 is the cell I used from the formula above to grab the last section of the string in A1) And this will delete anything after the very first number. This works exactly how I want it too, but I have no idea where to begin to implement this in the VBA Formula above.

Any help would be greatly appreciated!

Pᴇʜ
  • 56,719
  • 10
  • 49
  • 73
Maykid
  • 497
  • 3
  • 7
  • 17
  • Seeing as a regex solution has been proposed, here's a great [question](https://stackoverflow.com/questions/22542834/how-to-use-regular-expressions-regex-in-microsoft-excel-both-in-cell-and-loops) for further reading. – BigBen Nov 04 '19 at 18:05

2 Answers2

2

I also struggle with formulae like that, so I have used regular expressions, adding a few lines to your function. It's basically pattern matching. Your sub is as before.

Function StripAfter(ByVal txt As String, ByVal delimiter As String, ByVal occurrence As Long) As String

Dim x As Variant

x = Split(expression:=txt, delimiter:=delimiter, limit:=occurrence + 1)
StripAfter = x(UBound(x))

With CreateObject("VBScript.RegExp")
    .Global = True
    .Pattern = "\d+x\d+$"                                           'match 1+ numbers followed by x followed by 1+ numbers at the end of a string
    If .Test(StripAfter) Then StripAfter = .Replace(StripAfter, "") 'if pattern found replace with empty string
End With

End Function
SJR
  • 22,986
  • 6
  • 18
  • 26
  • This almost works 100% of the time. What happens if at the end it's either `x` or `X` is there a way to add either or in? I've tried doing a `If` `Then` statement but gives me an error right off the bat. – Maykid Nov 04 '19 at 18:34
  • 1
    nevermind I figured it out! I added in `.IgnoreCase = True` under `.Global = True` and that did the trick. Thank you so much, I truly appreciate as I couldn't figure this out at all! – Maykid Nov 04 '19 at 19:02
0

You could also try:

Option Explicit

Sub test()

    Dim LastRow As Long, i As Long, Chr As Long
    Dim str As String, NewStr As String

    With ThisWorkbook.Worksheets("Sheet1")

        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

        For i = 2 To LastRow

            str = .Range("A" & i).Value

            For Chr = 1 To Len(str)

                If Not IsNumeric(Mid(str, Chr, 1)) Then
                    NewStr = NewStr & Mid(str, Chr, 1)
                End If

            Next Chr

            .Range("B" & i).Value = NewStr
            NewStr = ""

        Next i

    End With

End Sub
Error 1004
  • 7,877
  • 3
  • 23
  • 46