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

[HockeyDiablo]

This is an additional question from post.

http://www.mrexcel.com/forum/excel-...left-right-defined-criteria-string-text.html#

I am curious on how to get the program to return additional columns if there is another instance of criteria

[TABLE="class: grid, width: 700"]
<tbody>[TR]
[TD][/TD]
[TD="align: center"]A[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]10 yr spring 399 rollers 188 sc 40 total 627 ck sc will be waived[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]$40 radio board and free sc over $500 $140 spring $103.80 40 sc total $283.80 ck [/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]argued sc reduce rate same day 5 yr 299 cables 58 rollers 148 sc 20 525 sc just because[/TD]
[/TR]
</tbody>[/TABLE]

The desired results would be:

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD][/TD]
[TD="align: center"]A[/TD]
[TD="align: center"]B[/TD]
[TD="align: center"]C[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]188,40[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD],500[/TD]
[TD]40,283.80[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD],5[/TD]
[TD]148,20[/TD]
[TD]525,[/TD]
[/TR]
</tbody>[/TABLE]

Sub NumsToRightAndLeftOf_sc() 'Rick Rothstein MrExcel MVP  Dim R As Long, X As Long, Criteria As String, S() As String
  Dim Data As Variant, SC As Variant, Result As Variant
  Criteria = "sc"
  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

TY to: Rick Rothstein

MrExcel MVP

I am basically looking to extract numbers to the right/left when a criteria is matched. But I want to add something where if there is a second instance of the criteria, to place that in the next respective column.

 

[Rick Rothstein]

[TABLE="class: grid, width: 700"]
<tbody>[TR]
[TD][/TD]
[TD="align: center"]A
[/TD]
[/TR]
[TR]
[TD]1
[/TD]
[TD]10 yr spring 399 rollers 188 sc 40 total 627 ck sc will be waived
[/TD]
[/TR]
[TR]
[TD]2
[/TD]
[TD]$40 radio board and free sc over $500 $140 spring $103.80 40 sc total $283.80 ck
[/TD]
[/TR]
[TR]
[TD]3
[/TD]
[TD]argued sc reduce rate same day 5 yr 299 cables 58 rollers 148 sc 20 525 sc just because
[/TD]
[/TR]
</tbody>[/TABLE]

The desired results would be:

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD][/TD]
[TD="align: center"]A
[/TD]
[TD="align: center"]B
[/TD]
[TD="align: center"]C
[/TD]
[/TR]
[TR]
[TD]1
[/TD]
[TD]188,40
[/TD]
[TD]627,[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]2
[/TD]
[TD],500
[/TD]
[TD]40,283.80
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]3
[/TD]
[TD],5
[/TD]
[TD]148,20
[/TD]
[TD]525,
[/TD]
[/TR]
</tbody>[/TABLE]

Why does doesn't what I highlighted in red on the top table produce the red result in cell B1 on the bottom table like the blue ones I highlighted did?

 

[HockeyDiablo]

I though I had included them in side there. Those are the accurate places.

 

[Rick Rothstein]

See if this macro does what you want...

[table="width: 500"]
[tr]
	[td]Sub NumsToRightAndLeftOf_sc()
  Dim R As Long, X As Long, Criteria As String, Data As Variant, SC As Variant
  Criteria = "sc"
  Data = Range("A1", Cells(Rows.Count, "A").End(xlUp))
  ReDim Result(1 To UBound(Data), 1 To 1)
  For R = 1 To UBound(Data)
    Data(R, 1) = Replace(Data(R, 1), Criteria, "|", , , vbTextCompare)
    For X = 1 To Len(Data(R, 1))
      If Not Mid(Data(R, 1), X, 1) Like "[0-9.|]" Then Mid(Data(R, 1), X) = " "
    Next
    Data(R, 1) = Trim(Replace(" " & Application.Trim(Data(R, 1)) & " ", " | ", ","))
    SC = Split(Data(R, 1))
    For X = 0 To UBound(SC)
      If InStr(SC(X), ",") = 0 Then SC(X) = ""
    Next
    Data(R, 1) = Application.Trim(Join(SC))
  Next
  Range("B1").Resize(UBound(Data)) = Data
  Columns("B").TextToColumns , xlDelimited, , , False, False, False, True, Other:=False, FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2))
End Sub[/td]
[/tr]
[/table]

 

[HockeyDiablo]

You have no idea on how grateful I am for this. I envy your skill and speed on this stuff. Flawless as always. You literally saved my behind. Could the Criteria be changed

Criteria = "sc"[CODE] by just replacing with the new criteria??  Yes, yes you can. I am so intrigued by this. Thank you so very much

 

[HockeyDiablo]

Thank you again

 

[HockeyDiablo]

I was working with this code today and now all it is giving me is a Run-time error '13': Type Mismatch in row

Data(R, 1) = Replace(Data(R, 1), Criteria, "|", , , vbTextCompare)

Dont understand this as it was working earlier? Even starting over from scratch with new sheets gives the same error?

 

[Rick Rothstein]

I was working with this code today and now all it is giving me is a Run-time error '13': Type Mismatch in row

Data(R, 1) = Replace(Data(R, 1), Criteria, "|", , , vbTextCompare)

Dont understand this as it was working earlier? Even starting over from scratch with new sheets gives the same error?

What is stored in Date(R, 1) and Criteria when the error occurs?

 

[HockeyDiablo]

I am unsure, I think it is something in my string that is causing the error. When I add 2-300 it seems to work fine, but all 56k rows it creates the error...

 

[HockeyDiablo]

There was one error in the mass of rows causing all my headaches.... Thank you Rick

What if I wanted to search for numbers and return the first words to the right/left??