Extract only numbers from Word table cell into Excel cell - vba

Question

I have a table in a word document that I need to extract only the numbers from. There are 2 cells in the document and the first one has the following string in it:
"24.00 (Hour(s))"
I just need the number "24" from that. It won't always be 2 digits since it's a duration of hours. It may be over 100. It's normally in that format "xxx.xxx" though.
The second cell I need to extract from is a bit more difficult. It looks like this:
"$125.00 to $140.00 per hour"
I would need to extract "125" and place it in a cell in excel and then extract "140" and place it in another cell. These number will always be between "$" and ".00" separated by the word "to".
The duration needs to go into column J and the rates need to be separated into column K & L.
Here is my current code:
Sub ImportWordTable()
Dim wdDoc As Object
Dim wdFileName As Variant
Dim TableNo As Integer 'table number in Word
Dim iTable As Integer 'table number index
Dim iRow As Long 'row index in Excel
Dim iCol As Integer 'column index in Excel
wdFileName = Application.GetOpenFilename("Word files (*.docx),*.docx", , _
"Browse for file containing table to be imported")
If wdFileName = False Then Exit Sub '(user cancelled import file browser)
Set wdDoc = GetObject(wdFileName) 'open Word file
Worksheets("Request Detail").Activate 'activates sheet of specific name
With wdDoc
TableNo = wdDoc.tables.Count
If TableNo = 0 Then
MsgBox "This document contains no tables", _
vbExclamation, "Import Word Table"
ElseIf TableNo > 1 Then
TableNo = InputBox("This Word document contains " & TableNo & " tables." & vbCrLf & _
"Enter table number of table to import", "Import Word Table", "1")
End If
For iTable = 1 To TableNo
Dim lRow As Long
lRow = Range("A" & Rows.Count).End(xlUp).Offset(1).Row + 1
With .tables(TableNo)
Cells(lRow - 1, "A") = WorksheetFunction.Clean(.cell(14, 2).Range.Text) 'polaris id
Cells(lRow - 1, "B").Value = Date 'post current date
Cells(lRow - 1, "C") = WorksheetFunction.Clean(.cell(16, 2).Range.Text) 'resource manager name
Cells(lRow - 1, "D") = WorksheetFunction.Clean(.cell(15, 2).Range.Text) 'requestor name
Cells(lRow - 1, "E") = WorksheetFunction.Clean(.cell(1, 2).Range.Text) 'customer name
Cells(lRow - 1, "H") = WorksheetFunction.Clean(.cell(7, 2).Range.Text) 'start date
Cells(lRow - 1, "I") = WorksheetFunction.Clean(.cell(8, 2).Range.Text) 'end date
Cells(lRow - 1, "J") = WorksheetFunction.Clean(.cell(9, 2).Range.Text) 'duration
Cells(lRow - 1, "K") = WorksheetFunction.Clean(.cell(12, 2).Range.Text) 'request low rate
Cells(lRow - 1, "L") = WorksheetFunction.Clean(.cell(12, 2).Range.Text) 'request high rate
'Cells(lRow - 1, "S") = WorksheetFunction.Clean(.cell(3, 2).Range.Text) need to post name of negotiatoe
End With
Next iTable
End With
Set wdDoc = Nothing
End Sub
Here is an example of the table parts I'm referring to:

Answer 1

Try this UDF and modify to suit your need. It returns a negative one (-1) if there isn't a match for the N'th number in a line of text.
Assuming the text in Word cell has been put into an Excel range (say C3), Hours stored in column D, Rate min in column E, Rate max in column F, then Formulas in:
D3: =GetNthNumber(C3)
E3: =GetNthNumber(C3,1)
F3: =GetNthNumber(C3,2)
You can do more if line of text contains "days" for the Time.
Option Explicit
Function GetNthNumber(oItem As Variant, Optional Nth As Long) As Double
Dim sText As String, n As Long, i As Long, oTmp As Variant
n = Nth
' Set to First if argument "Nth" is not passed in
If n <= 0 Then n = 1
' Retrieve the text from the input item
Select Case TypeName(oItem)
Case "Range": sText = oItem.Text
Case "String": sText = oItem
Case Else: sText = CStr(oItem)
End Select
i = 0 ' Initialize counter
' Loop through all the words in the text
For Each oTmp In Split(sText, " ")
' Process only if the word is a number
If IsNumeric(oTmp) Then
i = i + 1
' Check if it's the Nth number
If i = n Then
sText = oTmp
Exit For
End If
End If
Next
' Return -1 if there isn't an answer
If Not IsNumeric(sText) Then sText = "-1"
GetNthNumber = CDbl(sText)
End Function
UPDATE
For what you are interested in, first paste in my code above, on a new Module or bottom of your existing code, then change a few lines within the With .tables(TableNo) block to below:
Cells(lRow - 1, "J").Value = GetNthNumber(WorksheetFunction.Clean(.cell(9, 2).Range.Text)) 'duration (Time to Book?)
Cells(lRow - 1, "K").Value = GetNthNumber(WorksheetFunction.Clean(.cell(12, 2).Range.Text), 1) 'request low rate
Cells(lRow - 1, "L").Value = GetNthNumber(WorksheetFunction.Clean(.cell(12, 2).Range.Text), 2) 'request high rate