Find text and move it to other cell

[broogle]

Hi,

I have thousands of lines in a column, I need to find a text and move
it another column.

My data :

Col A

xxxx ABC1234 XXXX
xxxx ABC 1234 XXXx
xxxx ABC-1234 XXXx
xxxx ABC 1234a XXXx
xxxx ABC 1234ab XXXx
xxxx ABC-1234ab XXXx

What I need to find is the number and the last 1 or 2 character behind
it, such as 1234, 1234a or 1234ab and move it to column B.
ABC is fixed, but sometimes users put the space or "-" behind the ABC
and sometimes they use lower case.

I need the macro or the formula to figure it out, if possible.

Million of thanks.

 

[Norman Jones]

Hi Broogle,

Try:

Public Sub Tester001()

Dim rng As Range
Dim rCell As Range
Dim WB As Workbook
Dim SH As Worksheet
Dim CalcMode As Long
Const SearchString As String = "1234"

Set WB = ActiveWorkbook '<<========== CHANGE
Set SH = WB.Sheets("Sheet1") '<<========== CHANGE
Set rng = Intersect(SH.Columns(1), SH.UsedRange)

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

For Each rCell In rng.Cells
If InStr(1, rCell.Value, SearchString, vbTextCompare) > 0 Then
rCell(1, 2) = rCell.Value
rCell.ClearContents
End If
Next rCell

With Application
.Calculation = CalcMode
.ScreenUpdating = True
End With

End Sub

 

[Guest]

Can we chop the left (B1=right(A1, len(A1)-8))
then chop the right (C1=left(B1, len(B1)-5))
You can trim the space, but what do you want to do with the "-" please?

 

[broogle]

Thanks Norman,

Forgot to mention that 1234 is a variable, it can be 4356 or 7654 or
7888a, 4321tr, 2344G, etc.

 

[Norman Jones]

Hi Broogle,

You report your base data as of the form:

I understand that the 4-digit numeric string may vary.

However, what distinguishes the zero, 1 or 2 letter suffix to this numeric
string? Put another way, What are the XXX characters: numerics, upper case,
lower case or do they have a constant or special value

 

[Norman Jones]

Hi Broogle,

Try:

'==================>>
Public Sub Tester001()

Dim rng As Range
Dim rCell As Range
Dim wb As Workbook
Dim SH As Worksheet
Dim SStr As String
Dim CalcMode As Long
Const SearchString As String = "1234"

Set wb = ActiveWorkbook '<<========== CHANGE
Set SH = wb.Sheets("Sheet2") '<<========== CHANGE
Set rng = Intersect(SH.Columns(1), SH.UsedRange)

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

For Each rCell In rng.Cells
SStr = Mid(rCell.Value, 9)
SStr = Left(SStr, Len(SStr) - 5)
SStr = LTrim(SStr)
SStr = Replace(SStr, "-", "")
rCell(1, 2).Value = SStr
Next rCell

With Application
.Calculation = CalcMode
.ScreenUpdating = True
End With

End Sub
'==================>>

 

[broogle]

Hi Norman,

XXXX represent text, and the sufix are between a to z or A to Z.

i.e. "Building Maintenance Code BAS5644Na" or "Silo Materials Code
SIM7721" or "Maintenance on Progress Code MAT9021a", etc.

Thanks

 

[Norman Jones]

Hi Broogle,

How does:

"Building Maintenance Code BAS5644Na"

correspond to your data format definition:

!!!

Try:

'===================>>
Public Sub Tester001()

Dim rng As Range
Dim rCell As Range
Dim wb As Workbook
Dim SH As Worksheet
Dim SStr As String
Dim Pos As Long
Dim CalcMode As Long
Const SearchString As String = "1234"

Set wb = ActiveWorkbook '<<========== CHANGE
Set SH = wb.Sheets("Sheet2") '<<========== CHANGE
Set rng = Intersect(SH.Columns(1), SH.UsedRange)

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

For Each rCell In rng.Cells
If Not IsEmpty(rCell.Value) Then
SStr = rCell.Value
Pos = InStr(1, SStr, "Code", vbTextCompare)
SStr = Mid(SStr, Pos + 8)
SStr = Left(SStr, Len(SStr) - 5)
SStr = LTrim(SStr)
SStr = Replace(SStr, "-", "")
rCell(1, 2).Value = SStr
End If
Next rCell

With Application
.Calculation = CalcMode
.ScreenUpdating = True
End With

End Sub

'<<===================