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]

I would like to return what ever word is to the right or left of the desired search value "number", regardless if there are numbers after/before the "number"

"40"
bigsprings 599 gear and sprocket for ats 189 cables 8ft 129 sc 40 956 .430 42.5 SomeWord: sc,SomeWord
bigsprings 599 gear and sprocket for ats 189 cables 8ft 129 sc 40 956 .430 42.5: sc,

See if this macro does what you want...

[table="******* 500"]
[tr]
	[td]Sub WordsToRightAndLeftOf_40()
  Dim R As Long, X As Long, Criteria As Long, Data As Variant, Arr As Variant
  Criteria = 40
  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, Chr(1))
    For X = 1 To Len(Data(R, 1))
      If Mid(Data(R, 1), X, 1) Like "[!A-Za-z" & Chr$(1) & "]" Then Mid(Data(R, 1), X) = " "
    Next
    Data(R, 1) = Trim(Replace(" " & Application.Trim(Data(R, 1)) & " ", " " & Chr(1) & " ", ","))
    Arr = Split(Data(R, 1))
    For X = 0 To UBound(Arr)
      If InStr(Arr(X), ",") = 0 Then Arr(X) = ""
    Next
    Data(R, 1) = Application.Trim(Join(Arr))
  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]

Brilliant!!! It works great, but does pick up (-40) and (.40)

I dont think I have too many occurrences of those so I think I can think of a work around.

Cant thank you enough, again...

 

[HockeyDiablo]

It does pull instances of 140 also, not sure I can work around that?

5 yr 299 rollers 140 sc 40 total 487 cc: rollers,sc,total (3 returns?)
389 1/2hp head swap 2r 10y 59 remote 40 sc 488 total -40 online -5%aaa 22.40 425.60 total: remote,sc • total,online • aaa,total

 

[Rick Rothstein]

Brilliant!!! It works great, but does pick up (-40) and (.40)

I think this modified version of my code will ignore those...

[table="******* 500"]
[tr]
	[td]Sub WordsToRightAndLeftOf_40()
  Dim R As Long, X As Long, Criteria As Long, Data As Variant, Arr As Variant
  Criteria = 40
  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(Replace(Replace(Data(R, 1), "." & Criteria, ""), "-" & Criteria, ""), Criteria, Chr(1))
    For X = 1 To Len(Data(R, 1))
      If Mid(Data(R, 1), X, 1) Like "[!A-Za-z" & Chr$(1) & "]" Then Mid(Data(R, 1), X) = " "
    Next
    Data(R, 1) = Trim(Replace(" " & Application.Trim(Data(R, 1)) & " ", " " & Chr(1) & " ", ","))
    Arr = Split(Data(R, 1))
    For X = 0 To UBound(Arr)
      If InStr(Arr(X), ",") = 0 Then Arr(X) = ""
    Next
    Data(R, 1) = Application.Trim(Join(Arr))
  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]

Note
-------------
The key thing to keep in mind when asking a question in a forum... the volunteers you are asking to help you know absolutely nothing about your data, absolutely nothing about how it is laid out in the workbook, absolutely nothing about what you want done with it and absolutely nothing about how whatever it is you want done is to be presented back to you as a result... you must be very specific about describing each of these areas, in detail, and you should not assume that we will be able to "figure it out" on our own.

 

[HockeyDiablo]

That was exactly what I needed. It returned perfect for what I am looking for. Thank you so much.
Sorry if I couldn't provide clearer instruction, but please know I do try my best to convey what I need done and that you are very appreciated.

 

[Rick Rothstein]

That was exactly what I needed. It returned perfect for what I am looking for. Thank you so much.
Sorry if I couldn't provide clearer instruction, but please know I do try my best to convey what I need done and that you are very appreciated.

Yeah, but it does not handle 140, 240, etc. correctly... yet. I will look at correcting for that later this evening.

 

[HockeyDiablo]

Well I certainly appreciate that. I do see too where the _40 is causing issue, I just saw the .40 and -40 work so I assumed.

 

[Rick Rothstein]

Yeah, but it does not handle 140, 240, etc. correctly... yet. I will look at correcting for that later this evening.

Well I certainly appreciate that. I do see too where the _40 is causing issue, I just saw the .40 and -40 work so I assumed.

See if this code does everything you need...

[table="******* 500"]
[tr]
	[td]Sub WordsToRightAndLeftOf_40()
  Dim R As Long, X As Long, Criteria As Long, Data As Variant, Arr As Variant
  Criteria = 40
  Data = Range("A1", Cells(Rows.Count, "A").End(xlUp))
  For R = 1 To UBound(Data)
    Data(R, 1) = Replace(Data(R, 1), Criteria, Chr(1))
    For X = Len(" " & Data(R, 1)) - 1 To 1 Step -1
      If Mid(Data(R, 1), X, 2) Like "[! $]" & Chr(1) Then
        Mid(Data(R, 1), X, 2) = Space(2)
        Data(R, 1) = Application.Trim(Data(R, 1))
      Else
        If Mid(Data(R, 1), X, 1) Like "[!A-Za-z" & Chr$(1) & "]" Then Mid(Data(R, 1), X) = " "
      End If
    Next
    Data(R, 1) = Trim(Replace(" " & Application.Trim(Data(R, 1)) & " ", " " & Chr(1) & " ", ","))
    Arr = Split(Data(R, 1))
    For X = 0 To UBound(Arr)
      If InStr(Arr(X), ",") = 0 Then Arr(X) = ""
    Next
    Data(R, 1) = Application.Trim(Join(Arr))
  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]

Brilliant, it does work very well and remedied the _40 problem, but now I see it is returning values when 40 is the leading 2 digits of a larger number ex: 400, 4000, 40000...

 

[Rick Rothstein]

Brilliant, it does work very well and remedied the _40 problem, but now I see it is returning values when 40 is the leading 2 digits of a larger number ex: 400, 4000, 40000...

Okay, let's see if this version ends up doing all it is supposed to do...

[table="******* 500"]
[tr]
	[td]Sub WordsToRightAndLeftOf_40()
  Dim R As Long, X As Long, Criteria As Long, Data As Variant, Arr As Variant
  Criteria = 40
  Data = Range("A1", Cells(Rows.Count, "A").End(xlUp))
  For R = 1 To UBound(Data)
    Data(R, 1) = " " & Replace(Data(R, 1), Criteria, Chr(1)) & " "
    For X = Len(Data(R, 1)) - 2 To 2 Step -1
      If Mid(Data(R, 1), X - 1, 2) Like "[! ]" & Chr(1) Then
        Mid(Data(R, 1), X - 1, 2) = Chr(2) & Chr(2)
      ElseIf Mid(Data(R, 1), X, 2) Like Chr(1) & "[! ]" Then
        Mid(Data(R, 1), X, 2) = Chr(2) & Chr(2)
      End If
    Next
    For X = 1 To Len(Data(R, 1))
      If Mid(Data(R, 1), X, 1) Like "[!A-Za-z" & Chr(1) & "]" Then Mid(Data(R, 1), X) = " "
    Next
    Data(R, 1) = Trim(Replace(" " & Application.Trim(Data(R, 1)) & " ", " " & Chr(1) & " ", ","))
    Arr = Split(Data(R, 1))
    For X = 0 To UBound(Arr)
      If InStr(Arr(X), ",") = 0 Then Arr(X) = ""
    Next
    Data(R, 1) = Application.Trim(Join(Arr))
  Next
  Range("B1").Resize(UBound(Data)) = Data
  Columns("B").TextToColumns , xlDelimited, , , False, False, False, True, Other:=False
End Sub[/td]
[/tr]
[/table]