Add prefix to a number

[Gil]

Hello
I have a series of numbers in a column in the following format
002.1234
028.5678
014.9182
059.7451
They always start with a zero.
Other data exists in the same column both numeric and text
What I want to add is a four digit prefix
part 002.1234
part 028.5678
etc

I started off trying to use a find and replace with no success.
Any suggestions for the code would be gratefully received.

Gil

[mbarron]

Something like;

="part " & A1

or, is there more to consider - such as only items starting in 0 (zero)

=if(left(A1,1)=0,"part " & A1,A1)

[Gil]

mbarron
Thank you for the suggestion. I started off with this using * as wildcards. It does give the sort of result I am after but changes the numeric values to *.

[VBA]
Sub Macro1()
' Macro1 Macro
Cells.Select
Selection.Replace What:="0**.", Replacement:="part 0**.", LookAt:=xlPart _
, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub
[/VBA]

Gil

[mbarron]

If there are no numbers (no part numbers) whose value are greater than 0 and less than 1, you could use

Sub part_0()
With Selection
    .Value = Evaluate("=if(left(" & .Address & ",1)=""0"",""part "" &" & .Address & "," & .Address & ")")
End With
End Sub

[mdmackillop]

You would need to insert a prefix one cell at a time looping an If statement as suggested.

[Gil]

mbarron
There are other numbers in the column but none with that sequence with a full stop seperating the third & fourth character.
Does your code fit in a standard module and if so it has an error code of End If without block If.
Gil

mbarron
My mistake, ignore the line above regarding the error.
The code gives the correct result when run but also puts a zero into every empty cell in the column. This could be overcome by only selecting what you want but would prefer not to to happen.

[Gil]

mdmackillop
Thanks for the input but it seems to work without the loop except that it adds a zero into every empty cell in the column.
Gil

[mbarron]

If there are no numbers such where the decimal is in the 3rd position, such as 123.456, you can use the macro using Evaluate. If there are such numbers, use you'll have to use a loop. The Evaluate one did not like when I created a formula using a And(left(cell,1)="0",mid(cell,4,1)=".").

Sub part_0()
Dim str As String
With Selection
    str = "=if(mid(" & .Address & ",4,1) = ""."",""part "" & " & .Address & "," & .Address & ")"
    'Debug.Print str
    .Value = Evaluate(str)
End With
End Sub

Sub loopie()
Dim rng As Range
For Each rng In Selection
    If Left(rng, 1) = "0" And Mid(rng, 4, 1) = "." Then rng = "part " & rng
Next
End Sub

[GTO]

Hi there,

If mbarron's suggestion does not get it, could you post a workbook with a 'before' and 'after' column? Please include cell number formatting used and/or prefix char as is in your wb.

Mark

Edit: Ergh! I forgot to ask whether in the real wb, do you want it corrected in place, or in another column?

[Gil]

mbarron
With the info I have supplied both sets of code work ok except that any empty cells in the column have a zero inserted.
When applied to my project I have noticed that if there are any spaces or text preceeding my target number in the same cell then there is no result for that number. I have now added a worksheet with some test data and a before and after.
Gil

[Gil]

Hello GTO
The cell formatting is text and in the same column preferably.
Gil

[GTO]

From examples 1 and 2;

002.1234 wrong
abc 028.5678 wrong

Should they be(?):
'part 002.1234'
'abc part 028.5678'

[Gil]

GTO
Yes.Sorry for not making it clear
Gil

[mbarron]

Ignore my post - Not fully tested

[mbarron]

Does this one do what you want?

Sub part()
Dim rng As Range, str As String, iFS As Integer
For Each rng In Selection
   str = " " & rng
   iFS = InStr(str, ".")
   If iFS > 0 Then
      rng = Application.WorksheetFunction.Trim(Left(str, iFS - 4) & "part " & Mid(str, iFS - 4))
   End If
Next
End Sub

I noticed for "part 014.9182 abc" there are two spaces between the "2" and the "abc" do you want the "extra" space?

[Gil]

mbarron
It is looking good so far. Let me have some time to apply it and I will confirm later.
Many thanks for your help
Gil

[GTO]

Not well tested and I'm fairly confident there must be a better pattern...

Option Explicit
    
Sub exa()
    With ThisWorkbook.Worksheets("Sheet1").Range("A5:H8")
         .Value = CoerceVals(.Value)
    End With
End Sub
    
Function CoerceVals(ByVal ary As Variant) As Variant()
Dim rexMatches  As Object, x As Long, y As Long
ReDim aryRet(LBound(ary, 1) To UBound(ary, 1), LBound(ary, 2) To UBound(ary, 2))
With CreateObject("VBScript.RegExp")
        .Global = False
        .Pattern = "(.*)(\d{3}\.\d{4})(.*)"
        For x = LBound(ary, 1) To UBound(ary, 1)
            For y = LBound(ary, 2) To UBound(ary, 2)
                If .Test(ary(x, y)) Then
                    Set rexMatches = .Execute(ary(x, y))
                    aryRet(x, y) = rexMatches(0).SubMatches(0) & _
                    " part " & rexMatches(0).SubMatches(1) & rexMatches(0).SubMatches(2)
                   aryRet(x, y) = Application.Trim(aryRet(x, y))
                Else
                    aryRet(x, y) = ary(x, y)
               End If
           Next
        Next
        CoerceVals = aryRet
   End With
End Function

[GTO]

Crap. Much like the Tin Woodman, just hoping for a brain...

Change Pattern to:

.Pattern = "(.*)(\b\d{3}\.\d{4}\b)(.*)"

The word boundaries will prevent a 'number' with extra digits from providing a false match.

[Gil]

Hello GTO
mdbarron's solution works well but does pick up a couple of oddities but nothing that I can't live with. I will try your code but a bit stuck for time for a couple of days. Will reply asap.
Many thanks to you and mdbarron for the interest and support.
Gil

[Gil]

Hello GTO
Well tested now and works fine in my project. With the contribution from mdbarron I am spoilt for choice. Many thanks to you both and others in VBA Express who always step in to assist.
Thank you
Gil