Formatting cell with unique format while having different inputs

[Vincent88]

How and what is the best way to unify the inputs of a cell (ie "A2") : There will probably be three type of inputs
123456
req%123456
req000000123456
but I want to this cell ("A2") to turn these inputS to one single format REQ000000123456 (add REQ000000 to the last six digits of input)
I only know to formate 123456 in FORMAT CELLS / CUSTOM but no knowledge to tackle the other two !
Should I create a marco for this ?

 

[maabadi]

if you have textjoin function try this with CTRL+SHIFT+ENTER

=RIGHT(TEXTJOIN("",TRUE,IFERROR((MID(B2,ROW(INDIRECT("1:"&LEN(B2))),1)*1),"")),6)*1

if you have only one numbers at each text first add this UDF to your VBA

Public Function ExtractNumbers(Data As Range)
Dim s As String, arr As Variant
s = Data.Value
With CreateObject("vbscript.regexp")
    .Pattern = "[^1-9]"
    .Global = True
    .IgnoreCase = True
    arr = Split(Application.Trim(.Replace(s, " ")), " ")
End With
ExtractNumbers = arr
End Function

Now you can use it as function with input:

=ExtractNumbers(B2)

B2 is Cells Address has your Data. You can change it.
Then GO to Number format and Change it to Custom and at type Section Write:
"Req0000000"@

 

[Vincent88]

if you have textjoin function try this with CTRL+SHIFT+ENTER

=RIGHT(TEXTJOIN("",TRUE,IFERROR((MID(B2,ROW(INDIRECT("1:"&LEN(B2))),1)*1),"")),6)*1

if you have only one numbers at each text first add this UDF to your VBA

Public Function ExtractNumbers(Data As Range)
Dim s As String, arr As Variant
s = Data.Value
With CreateObject("vbscript.regexp")
    .Pattern = "[^1-9]"
    .Global = True
    .IgnoreCase = True
    arr = Split(Application.Trim(.Replace(s, " ")), " ")
End With
ExtractNumbers = arr
End Function

Now you can use it as function with input:

=ExtractNumbers(B2)

B2 is Cells Address has your Data. You can change it.
Then GO to Number format and Change it to Custom and at type Section Write:
"Req0000000"@

Hi Maabadi,
Thanks. This works. Is there any way that the marco be applied to the input cell A2 directly without involving any other cells (create a shortcut key to run the marco in A2) !

 

[maabadi]

I think you want Macro to Replaced Data at Column A (your Data Started from Cell A2). Is it Correct?
If yes. Add This Macro To VBA and Add ShortCut key for it. This one Convert all Data at Column A to your Format.
For add Shotcut Key Go to View (Or Developer) Tab , Select Macros Then ExtractNumbers2 Now Select Option & Add ShortCut Key you want.

Sub ExtractNumbers2()
' Keyboard Shortcut: Ctrl+Shift+L
Dim s As String, arr As Variant, Sr As Range, Lr As Long, Cell As Range
Lr = Range("A" & Rows.Count).End(xlUp).Row
Set Sr = Range("A2:A" & Lr)
For Each Cell In Sr
s = Cell.Value
With CreateObject("vbscript.regexp")
    .Pattern = "[^1-9]"
    .Global = True
    .IgnoreCase = True
    arr = Split(Application.Trim(.Replace(s, " ")), " ")
End With
Cell.Value = arr
Cell.Value = Cell.Value * 1
Next Cell
Sr.NumberFormat = """Req0000000""General"
End Sub

 

[Vincent88]

I think you want Macro to Replaced Data at Column A (your Data Started from Cell A2). Is it Correct?
If yes. Add This Macro To VBA and Add ShortCut key for it. This one Convert all Data at Column A to your Format.
For add Shotcut Key Go to View (Or Developer) Tab , Select Macros Then ExtractNumbers2 Now Select Option & Add ShortCut Key you want.

Sub ExtractNumbers2()
' Keyboard Shortcut: Ctrl+Shift+L
Dim s As String, arr As Variant, Sr As Range, Lr As Long, Cell As Range
Lr = Range("A" & Rows.Count).End(xlUp).Row
Set Sr = Range("A2:A" & Lr)
For Each Cell In Sr
s = Cell.Value
With CreateObject("vbscript.regexp")
    .Pattern = "[^1-9]"
    .Global = True
    .IgnoreCase = True
    arr = Split(Application.Trim(.Replace(s, " ")), " ")
End With
Cell.Value = arr
Cell.Value = Cell.Value * 1
Next Cell
Sr.NumberFormat = """Req0000000""General"
End Sub

Thanks Maabadi,
It works. Should I create a WORKSHEET_CALCULATE, WORKSHEET_SELECTIONCHANGE OR WORKSHEET_CHANGE to column A except cell A1 to trigger it whenever I input the cells !

 

[maabadi]

if you want worksheet Change event:
Right-Click on Sheet name at excel window and Paste this code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long, Lr As Long, s As String, arr As Variant
Dim Lr3 As Long, Lr4 As Long, K As Long
Lr = Range("A" & Rows.Count).End(xlUp).Row
  If Intersect(Target, Range("A2:A" & Lr)) Is Nothing Then Exit Sub
   If Target.Count > 1 Then Exit Sub
   Application.EnableEvents = False
    s = Target.Value
     With CreateObject("vbscript.regexp")
      .Pattern = "[^1-9]"
      .Global = True
      .IgnoreCase = True
      arr = Split(Application.Trim(.Replace(s, " ")), " ")
     End With
    Target.Value = arr
    Target.Value = Target.Value * 1
    Target.NumberFormat = """Req0000000""General"
   Application.EnableEvents = True
End Sub

 

[Vincent88]

if you want worksheet Change event:
Right-Click on Sheet name at excel window and Paste this code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long, Lr As Long, s As String, arr As Variant
Dim Lr3 As Long, Lr4 As Long, K As Long
Lr = Range("A" & Rows.Count).End(xlUp).Row
  If Intersect(Target, Range("A2:A" & Lr)) Is Nothing Then Exit Sub
   If Target.Count > 1 Then Exit Sub
   Application.EnableEvents = False
    s = Target.Value
     With CreateObject("vbscript.regexp")
      .Pattern = "[^1-9]"
      .Global = True
      .IgnoreCase = True
      arr = Split(Application.Trim(.Replace(s, " ")), " ")
     End With
    Target.Value = arr
    Target.Value = Target.Value * 1
    Target.NumberFormat = """Req0000000""General"
   Application.EnableEvents = True
End Sub

Thank for your guidance. Your kindness and help save me a lot of work.

 

[maabadi]

You're Welcome & Thanks for Feedback.

 

[Vincent88]

You're Welcome & Thanks for Feedback.

Hi Maabadi,
I found bug that when I delete a wrong input, the cell shows "REQ000000" before I enter another input. I cannot leave it blank any more. I tried to add an ELSE statement :
ELSE
if s="" then
Target.NumberFormat = """General"

but not work.
Please help

 

[maabadi]

Try this:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long, Lr As Long, s As String, arr As Variant
Dim Lr3 As Long, Lr4 As Long, K As Long
Lr = Range("A" & Rows.Count).End(xlUp).Row
  If Intersect(Target, Range("A2:A" & Lr)) Is Nothing Then Exit Sub
   If Target.Count > 1 Then Exit Sub
   Application.EnableEvents = False
    s = Target.Value
if s="" Then 
    Target.NumberFormat = "General"
Else
     With CreateObject("vbscript.regexp")
      .Pattern = "[^1-9]"
      .Global = True
      .IgnoreCase = True
      arr = Split(Application.Trim(.Replace(s, " ")), " ")
     End With
    Target.Value = arr
    Target.Value = Target.Value * 1
    Target.NumberFormat = """Req0000000""General"
End if
   Application.EnableEvents = True
End Sub