Isolating a certain area by stripping out unwanted charachters and numbers.

[CDandVinyl]

I'm trying to strip our extraneous elements of a reference number to leave just the numerical section.

Sometimes the reference number starts with letter , sometimes not. Each ends with an under score followed by other numbers and letters. Essentially , I need to remove any and all letters at the beginning and remove everything including and after the underscore.

For example :

CDU75945_CDbx185
CDU153900_LPsbx117
SU151683_CDbxMV1
141972_CDbx262
U151571_CDbx262
CDU93090_Boxbx194
U151845_7bxMV8
160884_CDsbx157
CDU160868_12bx192


Would become :


75945
153900
151683
141972
151571
93090
151845
160884
160868


The amount of rows containing these references would vary , as would the column they are in , so a message box requesting the column to work on would be helpful.

Can someone suggest some code to satisfy this?

I'll put a sample file below.

Grateful for any advice.

[oeldere]

Non VBA solution


F2=MAX(IFERROR(MID(E2,ROW($1:$100),COLUMN($A:$Z))*1,""))

confirm with CTRL+Shift + Enter


See the attached file.

[CDandVinyl]

Ok thanks. I think a VBA solution giving column choice and auto-locating the last row would be the best fit , but this certainly does the job.

[TMS]

@oeldere: brilliant. I have no idea how you approach a problem like this and come up with a solution like that. Very clever. Having worked through it, it seems it relies on the first numeric string being the longest/largest. Which seems fine for the data presented, and I’m sure that must be fairly representative.

[jolivanes]

Function borrowed from Scott Huish (https://www.mrexcel.com/board/thread...string.498357/)

Function removeAlpha(r As String) As String
With CreateObject("vbscript.regexp")
    .Pattern = "\D"
    .Global = True
    removeAlpha = .Replace(r, "")
End With
End Function

Re: so a message box requesting the column to work on would be helpful.
When the inputbox pops up, select any cell in the column in question.

Sub Clean_It_Up()
Dim c As Range, col As Long, lr As Long
    With Sheets("Sheet2")    '<---- Change as required
        col = Application.InputBox(Prompt:="Please select any cell in the column to be cleaned.", Title:="Please select a cell.", Type:=8).Column
        lr = .Cells(.Rows.Count, col).End(xlUp).Row
        Application.ScreenUpdating = False
            For Each c In .Range(.Cells(2, col), .Cells(lr, col))
                c.Value = removeAlpha(Left(c.Value, InStr(c.Value, "_") - 1))
            Next c
    End With
Application.ScreenUpdating = True
End Sub

[CDandVinyl]

Many thanks This works fine.

By the way , is it possible to modify the code to run on the first sheet , whatever it is named?

[TMS]

Simple VBA solution based on oeldere's formula approach.

Option Explicit

Sub ExtractNumber()

Const cSourceColumn As String = "E"

Dim lLR As Long
lLR = Range(cSourceColumn & Rows.Count).End(xlUp).Row

Application.ScreenUpdating = False

' add array formula for first row
Range(cSourceColumn & 2).Offset(, 1).FormulaArray = _
    "=MAX(IFERROR(MID(E2,ROW($1:$100),COLUMN($A:$Z))*1,""""))"

' copy array formula down
With Range(cSourceColumn & 2).Offset(, 1)
    .Copy Range(cSourceColumn & 3 & ":" & cSourceColumn & lLR).Offset(, 1)
End With

' convert to values
With Columns(cSourceColumn).Offset(, 1)
    .Value = .Value
End With

Application.ScreenUpdating = True

End Sub

[TMS]

By the way , is it possible to modify the code to run on the first sheet , whatever it is named?

Probably refer to Sheets(1)

[CDandVinyl]

Very good. Thanks all!

[TMS]

You're welcome. Thanks for the rep.

[oeldere]

Thanks for the rep.

Glad I could help.

Thanks for marking the question solved.

[CDandVinyl]

For my own curiosity , how would I select cell 1 in the column defined by the variable col in this coding provided by jolivanes?

Sub Clean_It_Up()
Dim c As Range, col As Long, lr As Long
    With Sheets("Sheet2")    '<---- Change as required
        col = Application.InputBox(Prompt:="Please select any cell in the column to be cleaned.", Title:="Please select a cell.", Type:=8).Column
        lr = .Cells(.Rows.Count, col).End(xlUp).Row
        Application.ScreenUpdating = False
            For Each c In .Range(.Cells(2, col), .Cells(lr, col))
                c.Value = removeAlpha(Left(c.Value, InStr(c.Value, "_") - 1))
            Next c
    End With
Application.ScreenUpdating = True
End Sub

I've been wrestling with it , but can't find the correct syntax. The variable col is defined by an input box , and to complete the macro I'd like it to select the cell at the top of the column on completion.

For example , if the column held by the variable is G , I want to select G1 at the end of the macro.

As it's a variable I'm struggling to find the code...

Grateful for any advice.

[TMS]

This:

Sub Clean_It_Up()
Dim c As Range, col As Long, lr As Long
    With Sheets("Sheet2")    '<---- Change as required
        col = Application.InputBox(Prompt:="Please select any cell in the column to be cleaned.", Title:="Please select a cell.", Type:=8).Column
        .Cells(1, col).Select
    End With
End Sub

[CDandVinyl]

That's it - perfect. Many thanks for your help.

[TMS]

You're welcome.