VBA to Remove Text Characters From Strings

[diderooy]

Hello,

I am a VBA novice and was able to Google a bunch of simple commands that I combined into a single macro, but I cannot figure out what to use to do the last needed item. Can you please help?

I have a large report (up to 3k rows of data) with a unique serial number identifier in each row. Theoretically, each of these serial numbers should begin with C and end with eight trailing digits ("C12345678"), but sometimes they have two Cs at the beginning, or have a V instead of a C, or have seven or nine digits trailing, etc. Just keying errors. I want to remove all the text characters, regardless of case, regardless of placement in the string, so I'm just left with the numbers, in the same cells as before, and want to have that combined within the same macro (as the last step of the macro).

The rest of the macro I've put together is:

Sub LOR()
Range("AF:AF").UnMerge
Range("AR13").Value = "LBS"
Range("1:12").Delete
Range("A:A, C:C, D:D, E:E, F:F, G:G, H:H, J:J, K:K, L:L, M:M, N:N, O:O, P:P, Q:Q, R:R, S:S, T:T, U:U, V:V, W:W, X:X, Y:Y, Z:Z, AA:AA, AB:AB, AC:AC, AD:AD, AE:AE, AF:AF, AG:AG, AH:AH, AI:AI, AJ:AJ, AK:AK, AL:AL, AM:AM, AN:AN, AP:AP, AQ:AQ, AS:AS, AT:AT").Delete
Range("A:D").WrapText = False
Range("1:3000").EntireRow.AutoFit
Range("A:D").EntireColumn.AutoFit
Columns("D").Cut
Columns("C").Insert Shift:=xlToRight
    Sheets("Sheet1").Select
    Range("A2:A3000").Select
    Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Dim cel As Range
For Each cel In Columns("C:D").SpecialCells(xlCellTypeConstants, 1)
cel.Value = Abs(cel)
Next
End Sub

So I'm unmerging, adding a text header to one column, deleting the top dozen rows, deleting a LOT of empty columns, unwrapping text, autofitting what's left, moving column D to the left of column C, deleting any now-empty rows within the sheet and making the values in columns C and D positive instead of negative. This is what I'm left with after that:

Please let me know if more detail is needed.

 

[Fuji]

Does this work?

    Dim e
    With Columns("b")
        For Each e In Array("c", "v")
            .Replace "*" & e, "'", 2
        Next
    End With

 

[diderooy]

I think that works to remove Cs or Vs from the worksheet, but there are a handful of other possible keying errors that could be made by the people putting together this data. I guess I was hoping I wouldn't have to add every possible character I wanted removed like the ("c", "v") portion as that makes it longer and a bit unwieldy. I will keep plugging away at it.

Thank you, Fuji!

 

[Fuji]

Then

    Dim a, i&
    With Range("b1", Range("b" & Rows.Count).End(xlUp))
        a = .Value
        With CreateObject("VBScript.RegExp")
            .Pattern = "^\D+"
            For i = 1 To UBound(a, 1)
                a(i, 1) = .Replace(a(i, 1), "'")
            Next
        End With
        .NumberFormat = "@"
        .Value = a
    End With

 

[Akuini]

Another option:
I add an apostrophe in case there are numbers that begin with 0, if you're sure that's not the case then you can replace:
va(i, 1) = "'" & tx
with this
va(i, 1) = tx

Sub diderooy_1()
Dim Matches As Object, M
Dim i As Long
Dim tx As String
Dim va
va = Range("B2", Cells(Rows.Count, "B").End(xlUp))
        With CreateObject("VBScript.RegExp")
                .Global = True
                .Pattern = "\d+"
            For i = 1 To UBound(va, 1)
                If .test(va(i, 1)) Then
                    Set Matches = .Execute(va(i, 1))
                    tx = ""
                    For Each M In Matches
                        tx = tx & M
                    Next M
                    va(i, 1) = "'" & tx
                End If
            Next
        End With
Range("B2").Resize(UBound(va, 1), 1) = va
End Sub

Example:

Book2
	B
1	test
2	C234536
3	C123456789
4	Q123X45TY8
5	CC123X45TY9
6	Q023X45TY10
Sheet1

Result:

Book2
	B
1	test
2	234536
3	123456789
4	123458
5	123459
6	0234510
Sheet1

 

[Fuji]

I want to remove all the text characters, regardless of case, regardless of placement in the string,

Remove all non-numeric characters.

    Dim a, i&
    With Range("b1", Range("b" & Rows.Count).End(xlUp))
        a = .Value
        With CreateObject("VBScript.RegExp")
            .Global = True
            .Pattern = "\D+"
            For i = 2 To UBound(a, 1)
                If .test(a(i, 1)) Then a(i, 1) = .Replace(a(i, 1), "")
            Next
        End With
        .NumberFormat = "@"
        .Value = a
    End With