1

I am working on small project. I have encountered a problem that I am not able to bypass. Any help would be highly appreciated. I have the following sheets: Sheet1 Sheet2

I need a function that extracts those 3 figures from Sheet1 (there can be more or less than 3), they are always limited by "()" and look for values in Sheet2 based on figures in column A1.

I was able to write the following code (with help of this question) for extracting figures, but I do not know how to isolate figures from single cell and look based on it in sheet2:

Edit:

I thought I will manage with the rest, but I was wrong. I would appreciate additional help to expand the code to return column B from Sheet2. Generally, logic is that function splits cell from sheet1 and then each item is looked in Sheet2. The final result of this function would be:

Test1 Test2 Test3

I have updated the code with what I tried myself.

Function onlyDigits(s As String) As String
Dim retval As String
Dim i,j As Integer
Dim TestRng as Range
Dim NoArr() as String
Dim TestRes() as String

retval = ""
s = Replace(s, ")", " ")
For i = 1 To Len(s)
    If Mid(s, i, 1) >= "0" And Mid(s, i, 1) <= "9" Or Mid(s, i, 1) = " " Then
        retval = retval + Mid(s, i, 1)
    End If
Next
'deletes last unnecessary space
retval = Left(retval, Len(retval) - 1) 
'array with results after extracting numbers
NoArr() = Split(retval, " ", , vbTextCompare)
'vlookedup range
set TestRng = Worksheets("Sheet2").Range("A1:B3")

For j = LBound(NoArr) To UBound(NoArr)

    TestRes(j) = Application.WorksheetFunction.VLookup(NoArr(j), TestRng, 2, 0)

Next j  

onlyDigits = TestRes 
End Function
Community
  • 1
  • 1
Raqu
  • 11
  • 4

2 Answers2

0

Keeping with your current method, I modified your function to return the value you need by passing in a place holder. I modified the first and second to last lines.

Function onlyDigits(s As String, pos As Integer) As String
    Dim retval As String
    Dim i As Integer

    retval = ""
    s = Replace(s, ")", " ")
    For i = 1 To Len(s)
        If Mid(s, i, 1) >= "0" And Mid(s, i, 1) <= "9" Or Mid(s, i, 1) = " " Then
            retval = retval + Mid(s, i, 1)
        End If
    Next
    'deletes last unnecessary space
    retval = Left(retval, Len(retval) - 1)
    onlyDigits = Split(retval, " ", , vbTextCompare)(pos)
End Function

To call in cell write: =onlyDigits(A1,0) the zero is the position to return

Example enter image description here

Column E shows the equation used in column D

Automate This
  • 30,726
  • 11
  • 60
  • 82
  • Thanks a lot, that is what I was looking for – Raqu Dec 21 '15 at 12:57
  • I thought I will manage with the rest by myself, but I didn't success. I have updated my question. Generally, logic is that function splits cell from sheet1 and then each item is vlooked in Sheet2. The final result of this function would be: Test1 Test2 Test3 – Raqu Dec 22 '15 at 11:54
0

ok I solved my problem with following code:

F    Function onlyDigits(s As String) As String
Dim retval As String
Dim i, j As Integer
Dim TestRng As Range
Dim NoArr() As String
Dim TestRes() As String

retval = ""
s = Replace(s, ")", " ")
For i = 1 To Len(s)
    If Mid(s, i, 1) >= "0" And Mid(s, i, 1) <= "9" Or Mid(s, i, 1) = " " Then
        retval = retval + Mid(s, i, 1)
    End If
Next
'deletes last unnecessary space
retval = Left(retval, Len(retval) - 1)
'array with results after extracting numbers
NoArr() = Split(retval, " ", , vbTextCompare)
'vlookedup range
Set TestRng = Worksheets("Sheet2").Range("A1:B3")

For j = LBound(NoArr) To UBound(NoArr)
    ReDim Preserve TestRes(j)
    TestRes(j) = Application.WorksheetFunction.VLookup(CLng(NoArr(j)), TestRng, 2, False)

Next j

onlyDigits = Join(TestRes, vbNewLine)
End Function
Raqu
  • 11
  • 4