VB Code to find certain text in column and copy digit part in diff column

[rmomin]

Hello

I have data as shown.
I need VB COde to do following
Look for 2 "#" in text in Column E.
Example will be "06/07/21 Check #x1126 #9112"

Now add last digit from #x1126 to #9112
So you will have
"06/07/21 Check #x1126 #91126"

Now take digit part of #91126 and put in column D same row.

I have manually done this as shown in yellow highlighted in column D.


Please let me know if you have any questions.
Thanks.

R

[nankw83]

Hi rmomin,

Try below code based on your sample file ...

Sub test()

Dim a, Txt$
a = Range("E2", Range("E" & Rows.Count).End(3))

For x = 1 To UBound(a)
   If InStr(a(x, 1), "#") Then Txt = Split(a(x, 1), "#")(2) & Right(Application.Trim(Split(a(x, 1), "#")(1)), 1)
   a(x, 1) = Txt: Txt = ""
Next
   
[D2].Resize(UBound(a)) = a

End Sub

[maniacb]

You can also try:

Sub addfinalnum()
Dim cel As Range
Dim fst&, lst&, pos&
Application.ScreenUpdating = False
For Each cel In Range("E2:E" & Cells(Rows.Count, 5).End(xlUp).Row)
    If InStr(cel, "#") > 1 Then
    fst = InStr(cel, "#")
    lst = InStrRev(cel, "#")
    pos = Mid(cel, fst + 5, 1)
    cel.Value = cel.Value & pos
    cel.Offset(, -1).Value = Mid(cel, lst + 1)
    End If
Next
Application.ScreenUpdating = True
End Sub

[rmomin]

Hello:

Thanks Nan and mani

Works greak

R

[rmomin]

Hello:

Below is your code, i am using with no issue for data as shown in Sheet1

But now have a look at Sheet2
I need help to modify the code so that it splits out check# as shown

Please let me know if you have any questions.
Thanks.

Riz

[maniacb]

Try

Sub addfinalnum_Upda()
Dim cel As Range
Dim fst&, lst&, pos&
Application.ScreenUpdating = False
For Each cel In Range("E2:E" & Cells(Rows.Count, 5).End(xlUp).Row)
    If InStr(cel, "#") > 1 Then
    fst = InStr(cel, "#")
    lst = InStrRev(cel, "#")
        If fst <> lst Then
            pos = Mid(cel, fst + 5, 1)  'Remove this line if want it to work like example, not description
            cel.Value = cel.Value & pos 'Remove this line if want it to work like example, not description
            cel.Offset(, -1).Value = Mid(cel, lst + 1)
        ElseIf fst = lst Then
            cel.Offset(, -1).Value = Mid(cel, lst + 1)
        End If
    End If
Next
Application.ScreenUpdating = True
End Sub

Note: in your initial description, you outline two steps:

Now add last digit from #x1126 to #9112
So you will have
"06/07/21 Check #x1126 #91126"

Now take digit part of #91126 and put in column D same row.

But your example only shows the second step. Should the outcome be like the description or your example? My code carries out the two steps in your description method.

[rmomin]

Hello

Thank you Maniacb, this should work for me.
Will contact if any issue or further enhancement needed.
R