PDA

View Full Version : Numbers from strings



rossmiddleto
12-21-2010, 09:33 AM
HI Everyone,

Just a quick one...

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

Kind Regards

Ross

Bob Phillips
12-21-2010, 09:38 AM
Depends if it is fixed

myNum = Val(Mid$(myString,4,3))

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

rossmiddleto
12-21-2010, 02:42 PM
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:

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

Bob Phillips
12-21-2010, 04:53 PM
This is a sledghammer approach to get them



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)


Regular Expressions would probably be better.

rossmiddleto
12-21-2010, 05:10 PM
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
12-22-2010, 01:06 AM
Try this



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)

Bob Phillips
12-22-2010, 01:19 AM
Or using RegExp



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))