Extract first numerical value to the left & right of a defined criteria from a string of text

[HockeyDiablo]

	A
1	10 yr spring 399 rollers 188 sc 40 total 627 ck
2	sc $40 radio board $140 spring $103.80 total $283.80 ck
3	same day 5 yr 299 cables 58 rollers 148 sc 40 545

<tbody>
</tbody>

Above are a few samples strings from Microsoft Excel that I need the extraction from, respectively in cells "A1", "A2", "A3"...

I have several items in the string and need to extract the pricing, but it could be to the left or the right and wont always carry a $ sign.

Example: I would like to select "sc" as the defined criteria and return the first numerical value to the left and right


Return: something like this

	B
1	188, 40
2	, 40
3	148, 40

<tbody>
</tbody>

I could work with values in "B" and "C"

 

[JLGWhiz]

Sorry, in my former post I have forgotten to quote your first code. Now checked your code in post #7 and no data in row 2 either.

I think it is because of the different settings, namely in row 2 "$40" is not recognized in your code by my Excel as "Isnumeric" but I think in your Excel is. If I change "$40" to, for example, "540" it works at me too.

I thought that might be it. Been trying to think of a concise way of getting around that glitch, but haven't as of yet.

 

[JLGWhiz]

I had an epiphany, try this:

Sub t()
Dim rng As Range, c As Range, ary As Variant
    With ActiveSheet
        Set rng = .Range("A1", .Cells(Rows.Count, 1).End(xlUp))
    End With
    For Each c In rng
        ary = Split(c.Value, " ")
            For i = LBound(ary) To UBound(ary)
                If ary(i) = "sc" Then
                    If i > LBound(ary) Then
                        If IsNumeric(ary(i - 1)) Then
                            c.Offset(, 1) = ary(i - 1)
                        End If
                    End If
                    If IsNumeric(Replace(ary(i + 1), "$", "")) Then
                        c.Offset(, 2) = ary(i + 1)
                    End If
                    Exit For
                End If
            Next
    Next
End Sub

 

[István Hirsch]

With the code in post #12 I get this (do not worry, for the OP your code may be totally correct, my computer works with continental settings):

Excel Workbook
	A	B	C
1	10 yr spring 399 rollers 188 sc 40 total 627 ck	188	40
2	sc $40 radio board $140 spring $103.80 total $283.80 ck		?40
3	same day 5 yr 299 cables 58 rollers 148 sc 40 545	148	40
Sheet

 

[JLGWhiz]

With the code in post #12 I get this (do not worry, for the OP your code may be totally correct, my computer works with continental settings):

Excel Workbook
	A	B	C
1	10 yr spring 399 rollers 188 sc 40 total 627 ck	188	40
2	sc $40 radio board $140 spring $103.80 total $283.80 ck	*	?40
3	same day 5 yr 299 cables 58 rollers 148 sc 40 545	148	40
Sheet

This looks like it is working. Your system is automatically converting the $ symbol to the symbol for your system setting, which would be correct. Now, if you do not want the symbol, then simply use the Replace function in the next line like this.

c.Offset(, 2) = Replace(ary(i + 1), "$", "")

In fact if you have symbols on both sides of the 'sc' then you can use the replace function for all the ary(i +or-) designations to remove the symbols in columns B and C.

Regards, JLG

 

[Rick Rothstein]

	A
1	10 yr spring 399 rollers 188 sc 40 total 627 ck
2	sc $40 radio board $140 spring $103.80 total $283.80 ck
3	same day 5 yr 299 cables 58 rollers 148 sc 40 545

<tbody>
</tbody>

Above are a few samples strings from Microsoft Excel that I need the extraction from, respectively in cells "A1", "A2", "A3"...

Example: I would like to select "sc" as the defined criteria and return the first numerical value to the left and right


Return: something like this

	B
1	188, 40
2	, 40
3	148, 40

<tbody>
</tbody>

I could work with values in "B" and "C"

Does this macro do what you want...

[table="width: 500"]
[tr]
 [td]Sub NumsToRightAndLeftOf_sc()
  Dim R As Long, X As Long, Criteria As String, S() As String
  Dim Data As Variant, SC As Variant, Result As Variant
  [COLOR=#0000FF]Criteria = "sc"[/COLOR]
  Data = Range("A1", Cells(Rows.Count, "A").End(xlUp))
  ReDim Result(1 To UBound(Data), 1 To 1)
  For R = 1 To UBound(Data)
    SC = Split(" " & Replace(Data(R, 1), "$", "") & " ", " " & Criteria & " ", , vbTextCompare)
    If UBound(SC) > 0 Then
      S = Split(Trim(SC(0)))
      If UBound(S) = -1 Then Result(R, 1) = "" Else Result(R, 1) = S(UBound(S))
      Result(R, 1) = Result(R, 1) & ", " & Split(Trim(SC(1)))(0)
    End If
  Next
  Range("B1").Resize(UBound(Result)) = Result
End Sub
[/td]
[/tr]
[/table]

 

[István Hirsch]

Hi JLGWHiz,

Thanks for trying to adapt your code to my excel but it is not neccessary because it is not me who is copying with the problem described in post #1: it is HockeyDiablo. As for me, I am also a helper and suggested a UDF solution in post #6.

I mentioned the difference in the result just to draw the OP's attention to a possible issue that might arise at the OP.

Regards,
István

 

[JLGWhiz]

Hi JLGWHiz,

Thanks for trying to adapt your code to my excel but it is not neccessary because it is not me who is copying with the problem described in post #1: it is HockeyDiablo. As for me, I am also a helper and suggested a UDF solution in post #6.

I mentioned the difference in the result just to draw the OP's attention to a possible issue that might arise at the OP.

Regards,
István

It gives me something to do. It was an interesting set-up that I had not contemplated when I wrote the original code. Rick has streamlined it a little. The OP probably left work and won't respond until tomorrow.

 

[HockeyDiablo]

Thanks for all your help guys. The OP and Mrs. OP welcomed their 2nd son into the world. Sorry for the delay.

JLG #12 worked great but got an error code when the script finished?

If IsNumeric(Replace(ary(i + 1), "$", "")) Then

on debug.

Rick, this man is just great people. Seriously, he has came through for me countless times. Getting a simple error but its most likely something I am doing as always.

Thanks again guys!

 

[Rick Rothstein]

Getting a simple error but its most likely something I am doing as always.

What is the error number and description?

What line of code does the debugger highlight when the error occurs?

 

[HockeyDiablo]

Runtime Error '9' Script out of range

Result(R, 1) = Result(R, 1) & ", " & Split(Trim(SC(1)))(0)

But it works when I use other data? Would a certain character throw this off??