VBA text conversion into Number Help

[Zakolka]

Hi Guys,

sorry if I am in the wrong place, but I was looking for some help. Below is my original data outsourced from Reflection. As you might see all numbers are in different format, so I had to get it to excel in text format. Next challenge is to convert it into workable number format. My initial idea was>
1. to lose all non-numeric characters
2. to insert delimiter using divide function



Original Text String



2,800.00



162.67



1,754.90



309.56



165.00



960.00



2,800.00



1'473.68



1'159.76



2.800,00



5.014,00




I found VBA codes that are functioning perfectly when run separately. Problem that I faced while trying to combine codes 1st function is not functioning properly.
Hope you can help.



Code #1
eliminates all non-numeric and non-alphabetical characters withing selected range



Code #2
divides number for selected amount within given range



Code #1 and #2 combined
gives me inaccurate results :banghead:

[Logit]

I'm not certain of the final goal with the code ... however, I've worked through it ... removed what wasn't required and added DIM statements for existing code that needed it.



Sub Code1()
'Updateby2014128
Dim Rng As Range
Dim WorkRng As Range
Dim xout As String
Dim i As Integer
Dim xTemp As String
Dim xStr As String


On Error Resume Next
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", WorkRng.Address, Type:=8)
For Each Rng In WorkRng
xout = ""
For i = 1 To Len(Rng.Value)
xTemp = Mid(Rng.Value, i, 1)
If xTemp Like "[a-z]" Or xTemp Like "[A-Z]" Or xTemp Like "[0-9]" Then
xStr = xTemp
Else
xStr = ""
End If
xout = xout & xStr
Next i
Rng.Value = xout
Next
Code2
End Sub


Sub Code2()
'Updateby20140128
Dim Rng As Range
Dim WorkRng As Range
Dim xNum As Integer
On Error Resume Next
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", WorkRng.Address, Type:=8)
xNum = Application.InputBox("Division num", Type:=1)
For Each Rng In WorkRng
Rng.Value = Rng.Value / xNum
Next
End Sub

[rlv]

I took a stab at it.


Sub CodeX()
Dim Rng As Range, R As Range
Dim NumStr As String
Dim DPos As Long, APos As Long, CPos As Long
Dim Word1 As String, Word2 As String


With ActiveSheet
Set Rng = Application.Intersect(.UsedRange, .Columns(1)).Offset(1).Resize(.UsedRange.Rows.Count - 1)
End With


For Each R In Rng
NumStr = Trim(CStr(R.Value))
DPos = InStr(NumStr, ".")
CPos = InStr(NumStr, ",")
APos = InStr(NumStr, "'")


If DPos + CPos + APos = 0 Then
ClearPos DPos, APos, CPos 'just a number
End If


If CPos > 0 And APos > 0 Then
NumStr = "0" 'illegal combo
ClearPos DPos, APos, CPos
End If


If APos > 0 Then
NumStr = Replace(NumStr, "'", vbNullString) 'apos separator (implies dot as decimal mark)
ClearPos DPos, APos, CPos
End If


If DPos > 0 And CPos > 0 Then ' dot-comma
If DPos < CPos Then
'dot is separator
NumStr = Replace(NumStr, ".", vbNullString)
NumStr = Replace(NumStr, ",", ".")
Else
'comma is separator
NumStr = Replace(NumStr, ",", vbNullString)
End If
ClearPos DPos, APos, CPos
End If


If DPos > 0 And CPos = 0 Then 'dot only
If DPos <> InStrRev(NumStr, ".") Then
NumStr = Replace(NumStr, ".", vbNullString)
Else
Word1 = Left(NumStr, DPos - 1)
Word2 = Mid(NumStr, DPos + 1, 100)
If Len(Word1) <= 3 And Len(Word2) = 3 Then
NumStr = Replace(NumStr, ".", vbNullString) 'probably a separator
End If
End If
ClearPos DPos, APos, CPos
End If


If DPos = 0 And CPos > 0 Then 'comma only
If CPos <> InStrRev(NumStr, ",") Then
NumStr = Replace(NumStr, ",", vbNullString)
Else
Word1 = Left(NumStr, CPos - 1)
Word2 = Mid(NumStr, CPos + 1, 100)
If Len(Word1) <= 3 And Len(Word2) = 3 Then
NumStr = Replace(NumStr, ",", vbNullString) 'probably a separator
Else
NumStr = Replace(NumStr, ",", ".") 'ok, perhaps a decimal mark.
End If
End If
ClearPos DPos, APos, CPos
End If
R.Offset(0, 1).Value = CDbl(NumStr)
Next R
End Sub


Sub ClearPos(ByRef DPos As Long, ByRef APos As Long, ByRef CPos As Long)
DPos = 0
CPos = 0
APos = 0
End Sub

[Logit]

Impressive rlv !

[Paul_Hossler]

@Zakolka -- I tried to add the
... tags for you and however you pasted in your macros they got cleared

Sorry


You'll have to re-add your macros again

Please use the [#] icon at the top to insert ....





Sub ... ...


End Sub



and paste your macros between them so that it looks like





Sub MyMacro


End Sub

[snb]

A one-liner suffices:


Sub M_snb()
[B2:B16] = [if(left(right(A2:A16,3),1)=".",substitute(substitute(left(A2:A16,len(A2:A16)-3),"'",""),",","") & "," & right(A2:A16,2),substitute(substitute(A2:A16,"'",""),".",""))]
End Sub

or


Sub M_snb()
Range("A2:A16").Name = "snb"
[snb].Offset(, 1) = [if(left(right(snb,3),1)=".",substitute(substitute(left(snb,len(snb)-3),"'",""),",","") & "," & right(snb,2),substitute(substitute(snb,"'",""),".",""))]
End Sub

[Zakolka]

Hi Snb,
the idea is to convert a numeric text string to a number using relative references (range, delimiter, and amount of decimals).
Given that original string might reflect numbers in various formats (1'205.50 .... 6'698,00.... 1.320,00 and 3,562.00 ) and - I cannot just re-format them.
1st Macro I was using to get rid of any symbols and spaces is below:




Sub RemoveNotAlphasNotNum()
'Updateby2014128
Dim Rng As Range
Dim WorkRng As Range
On Error Resume Next
xTitleId = "KutoolsforExcel"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
For Each Rng In WorkRng
xOut = ""
For i = 1 To Len(Rng.Value)
xTemp = Mid(Rng.Value, i, 1)
If xTemp Like "[a-z]" Or xTemp Like "[A-Z]" Or xTemp Like "[0-9]" Then
xStr = xTemp
Else
xStr = ""
End If
xOut = xOut & xStr
Next i
Rng.Value = xOut
Next
End Sub


2nd Marco I wanted to use is actually might not be exactly what I wanted... but at least it gives me required result by dividing cells in given range for request amount (e.g. 2000/10 = 20.00).
If you could suggest any other code that would insert desired text/delimiter into the cell (e.g. insert "," into 3rd position from left) - it would be even better.




Sub DivisionNum()
'Updateby20140128
Dim Rng As Range
Dim WorkRng As Range
Dim xNum As Integer
On Error Resume Next
xTitleId = "KutoolsforExcel"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
xNum = Application.InputBox("Division num", xTitleId, Type:=1)
For Each Rng In WorkRng
Rng.Value = Rng.Value / xNum
Next
End Sub



Thanks In Advance :)

[snb]

Please read my post, that's all (1-liner) you need.

Post a sample file in which you have incorporated my code.