Numbers from strings

[rossmiddleto]

HI Everyone,

Just a quick one...

how do i pull numbers out of an alphanumerical range using VBA?

Kind Regards

Ross

[Bob Phillips]

Depends if it is fixed

[VBA]myNum = Val(Mid$(myString,4,3))[/VBA]

or if not, is there some flag character to look for.

[rossmiddleto]

Thanks for the suggestion but there are no common elements to the strings as follows:


I have some working code that does the following

1) Imports a table from the web into sheet 2
2) Uses a loop to lookup values of stocks/shares etc from sheet 2 and paste them into the first empty cell in a row in sheet 1 depending on their corresponding names. ie for the name "OIL" in sheet 1, the code would search sheet 2 for the word "OIL" and then take the cell next to it and paste it into sheet 1 next to the word "OIL"


I would like to find some code that extracts the numbers from my copied cells so that I can perform calculations on them.

At the moment some of the cells that are copied across are things like "1,922GBP" and I need to just extract the numbers from the string. The lenght of the number changes along with the decimal places and the currency sign so there is no common elements to the string so I cannot use something like the MID function.


Please help!

Regards,

Ross


Current working code:

[vba]Sub Move_Cells()
Dim i As Integer
Dim SourceCell As Range, DestinationCell As Range, Com As Range, destinationcell2 As Range

i = 1

Set Com = Sheets("Sheet1").Cells.Find(What:="Commodities", LookIn:=xlValues, LookAt:=xlPart)

If Not Com Is Nothing Then
Do
Set SourceCell = Sheets("Sheet2").Cells.Find(What:=(Com.Offset(i, 0).Value), _
LookIn:=xlValues, LookAt:=xlPart)
Set DestinationCell = Sheets("Sheet1").Cells.Find(What:=(Com.Offset(i, 0).Value), _
LookIn:=xlValues, LookAt:=xlPart)

If Not DestinationCell = "" Then
If DestinationCell.Font.Bold = False Then


DestinationCell.End(xlToRight).Offset(0, 1).Value = SourceCell.Offset(0, 1).Value

End If
End If

i = i + 1

Loop Until IsEmpty(Com.Offset(i, 0)) And IsEmpty(Com.Offset(i + 1, 0))
End If

End Sub[/vba]

[Bob Phillips]

This is a sledghammer approach to get them

[vba]

tmp = ""
For i = 1 To Len(cell.Value)

If IsNumeric(Mid$(cell.Value, i, 1)) Then

tmp = tmp & Mid$(cell.Value, i, 1)
End If
Next i
cell.Value = Val(tmp)
[/vba]

Regular Expressions would probably be better.

[rossmiddleto]

Works like a dream! Thank you!

Is there anyway you know of keeping leading zero and decimal place of the string? At the moment a value of 0.201 is being displayed as 201 which is a completely different value.

Thanks again,

Ross

[Bob Phillips]

Try this

[vba]

tmp = ""
For i = 1 To Len(cell.Value)

If IsNumeric(Mid$(cell.Value, i, 1)) Or Mid$(cell.Value, i, 1) = "." Then

tmp = tmp & Mid$(cell.Value, i, 1)
End If
Next i
cell.Value = Val(tmp)
[/vba]

[Bob Phillips]

Or using RegExp

[vba]

Dim regexp As Object
Dim reMatches As Object
Dim cell As Range

Set regexp = CreateObject("VBScript.RegExp")
With regexp
.MultiLine = False
.Global = False
.IgnoreCase = True
.Pattern = "[0-9.]+"
End With

Set reMatches = regexp.Execute(cell.Value)
cell.Value = Val(reMatches(0))
[/vba]