Remove text from numbers

Question

Hi there

I need to remove all text from numbers within a cell, then split the two numbers across two cells and be formatted as numbers, not text. The cell contains text/numbers in the following formats:

between 150,000 and 159,999 per annum

between 60 and 65 per hour

between 70.00 and 74.00 per hour

There may be 1000s of other lines of these and they will always start in H2. There are occupied cells either side.

If possible the code needs to form part of a bigger macro that has actions before and after so it would be great to be able to copy and paste it into the middle.

I've attached a sample of how it looks and how I'd like it to look - there are two tabs for clarity but I'd like the solution to remain on the same tab.

Thanks in advance for your help.

Steve

Answer 1

• Copy the code below into a regular module
• Add 2 column after column H
• Select the cells I2:J2
• Enter the formula =ExtractNumbers(H2) into the formula bar
• Press CTRL-SHIFT-ENTER
• Drag the formula down

Andreas.

Function ExtractNumbers(ByVal S As String) As Variant

  'Returns an array with all numbers in S

  Dim i As Long

  'Overwrite non-numbers with blanks

  For i = 1 To Len(S)

    If Not IsNumeric(Mid$(S, i, 1)) Then Mid$(S, i, 1) = " "

  Next

  'Remove double blanks

  Do While InStr(S, "  ") > 0

    S = Replace(S, "  ", " ")

  Loop

  'Split the string by blanks into an array

  ExtractNumbers = Split(Trim(S))

End Function

Answer 2

Thanks guys, both solutions work perfectly!

Answer 3

Use

Dim i As Long, j As Long

Dim lower As String, upper As String

With Worksheets(1)

    i = .Range("A1").CurrentRegion.Rows.Count

    .Columns("H:I").Select

    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

    .Range("A1").Offset(0, 7).Value = "Lower"

    .Range("A1").Offset(0, 8).Value = "Upper"

    For j = 1 To i - 1

        lower = Mid(.Range("A1").Offset(j, 9), 9)

        upper = Mid(lower, InStr(lower, "a") + 3)

        upper = Left(upper, InStr(upper, "p") - 1)

        lower = Left(lower, InStr(lower, "a") - 1)

        .Range("A1").Offset(j, 7).Value = Val(Replace(lower, ",", ""))

        .Range("A1").Offset(j, 8).Value = Val(Replace(upper, ",", ""))

    Next j

    .Columns("J:J").Select

    Selection.Delete Shift:=xlToLeft

End With