PDA

View Full Version : [SOLVED] Add prefix to a number



Gil
05-24-2010, 08:08 AM
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
05-24-2010, 08:27 AM
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
05-24-2010, 08:46 AM
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 *.


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


Gil

mbarron
05-24-2010, 09:48 AM
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
05-24-2010, 09:52 AM
You would need to insert a prefix one cell at a time looping an If statement as suggested.

Gil
05-24-2010, 10:29 AM
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
05-24-2010, 11:15 AM
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
05-24-2010, 11:18 AM
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
05-24-2010, 11:31 AM
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
05-24-2010, 11:54 AM
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
05-24-2010, 12:12 PM
Hello GTO
The cell formatting is text and in the same column preferably.
Gil

GTO
05-24-2010, 12:29 PM
From examples 1 and 2;

002.1234 wrong
abc 028.5678 wrong

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

Gil
05-24-2010, 12:32 PM
GTO
Yes.Sorry for not making it clear
Gil

mbarron
05-24-2010, 01:13 PM
Ignore my post - Not fully tested

mbarron
05-24-2010, 01:21 PM
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
05-24-2010, 02:02 PM
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
05-24-2010, 03:33 PM
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
05-24-2010, 03:58 PM
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
05-24-2010, 08:33 PM
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
05-26-2010, 05:34 AM
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