Extract data after "-" VBA

[Liam4567]

**VBA**

Hi

I have a string that will change daily and looks something like this "09876 k-wef234 £45678.99 Option 4 -£123456.57"

I am trying to find the best way of extracting the "-£123456.57" after "Option 4 -£123456.57". I need the code to always look for Option 4 as that is the one part that will always stay the same, and the number after will always start with a minus. It needs to look for Option 4 as it is going to loop through multiple rows of data looking for the words Option 4.

I will then be using that figure (-£123456,57) to be the value of a cell on another sheet.

Thanks in advance.

 

[Peter_SSs]

Welcome to the MrExcel board!

Could we have a few more samples (and expected results) to show the sorts of variation (or lack of) that might occur with your data. XL2BB would be really good.

 

[Liam4567]

Welcome to the MrExcel board!

Could we have a few more samples (and expected results) to show the sorts of variation (or lack of) that might occur with your data. XL2BB would be really good.

Hi

Samples:
07093409476 k-ioertuio £45678.99 Option 4 -£167893.57
TestSmpl -08h Option 4 -£76839.84

My code at the minute is:


For Each c In Sheets("PDF").Range("A1:A" & RowEnd)
If InStr(c.Value, "Option 4") Then

End If
Next c


Does this help at all?

 

[HaHoBe]

Hi Liam,

maybe use Split with the delimiter of "Option 4 " to split the values up and write part of the array to the other sheet like

Sub Liam4567()
' https://www.mrexcel.com/board/threads/extract-data-after-vba.1157678/

'please adjust sheetnamess or positions and Columns/Rows as well as offset as needed

Dim vsplit As Variant
Dim lngCounter As Long

Const cstrDELIMIT As String = "Option 4 "
Const cstrCOL As String = "A"
Const cstrOUT As String = "F"
Const clngOFFSET As Long = 10

For lngCounter = 1 To Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row
  vsplit = Split(Sheets("PDF").Cells(lngCounter, cstrCOL).Value, cstrDELIMIT)
  Sheets(2).Cells(lngCounter + clngOFFSET, cstrOUT).Value = vsplit(1)
Next lngCounter

End Sub

Ciao,
Holger

 

[HaHoBe]

Hi Liam3456,

alternatively you may make use of InstrRev and Mid Funxtions, search for the last blank from the right of the string and use that position + 1 for thge struinbg to copy as in

Sub Liam4567_alt()
' https://www.mrexcel.com/board/threads/extract-data-after-vba.1157678/

'please adjust sheetnamess or positions and Columns/Rows as well as offset as needed

Dim lngCounter As Long
Dim intPos As Integer

Const cstrSH_From As String = "PDF"
Const cstrSH_TO As String = "Output"
Const cstrCOL As String = "A"
Const cstrOUT As String = "G"
Const clngOFFSET As Long = 5

With Sheets(cstrSH_From)
  For lngCounter = 1 To .Cells(Rows.Count, "A").End(xlUp).Row
    intPos = InStrRev(.Cells(lngCounter, cstrCOL).Value, " ")
    If intPos > 0 Then
      Sheets(cstrSH_TO).Cells(lngCounter + clngOFFSET, cstrOUT).Value = Mid(.Cells(lngCounter, cstrCOL).Value, intPos + 1)
    End If
  Next lngCounter
End With

End Sub

Ciao,
Hiolger

 

[Peter_SSs]

show the sorts of variation (or lack of) that might occur

Samples:
07093409476 k-ioertuio £45678.99 Option 4 -£167893.57
TestSmpl -08h Option 4 -£76839.84

Hmm, I'm not confident that will show the variety or lack of variety in your data but if it does, then the Option 4 always exists in the text and the number to be extracted is always at the very right of the string. In that case, and suppose you want the results in Sheet2 column A, try this. (You may need to adjust the number format of the final result as I wasn't quite sure of that compared to your original data.

Sub ExtractNumber()
  Dim a As Variant
  
  With Sheets("PDF")
    With .Range("A2", .Range("A" & Rows.Count).End(xlUp))
      a = Evaluate(Replace("-right(substitute(#,""£"",rept("" "",20)),20)", "#", .Address(External:=True)))
    End With
  End With
  With Sheets("Sheet2").Range("A2").Resize(UBound(a))
    .NumberFormat = "£0.00"
    .Value = a
    .Columns.AutoFit
  End With
End Sub

If it turns out this does not meet your need because the sample data was not fully representative, then please give us some that is.

 

[Liam4567]

Hmm, I'm not confident that will show the variety or lack of variety in your data but if it does, then the Option 4 always exists in the text and the number to be extracted is always at the very right of the string. In that case, and suppose you want the results in Sheet2 column A, try this. (You may need to adjust the number format of the final result as I wasn't quite sure of that compared to your original data.

Sub ExtractNumber()
  Dim a As Variant
 
  With Sheets("PDF")
    With .Range("A2", .Range("A" & Rows.Count).End(xlUp))
      a = Evaluate(Replace("-right(substitute(#,""£"",rept("" "",20)),20)", "#", .Address(External:=True)))
    End With
  End With
  With Sheets("Sheet2").Range("A2").Resize(UBound(a))
    .NumberFormat = "£0.00"
    .Value = a
    .Columns.AutoFit
  End With
End Sub

If it turns out this does not meet your need because the sample data was not fully representative, then please give us some that is.

Hi Peter_SSs

Sorry I wasn't very clear before.

The above solution seems to work very well, however before it gets to that, it needs to loop through the entire data in column A which is around 100 rows or so, looking for the text "Option 4", and then removing only the number from that cell after "Option 4".

But you are right in saying that Option 4 will always exists in one cell within the data, and the number to be extracted will always be at the very right of the string.

I have uploaded an image below to give you a better idea of what I mean, however I have cut it down to 9 rows and highlighted the cell it would need to find.

 

[Peter_SSs]

You still haven't given us the desired resultant data/layout but see if this change does what you want.
If it doesn't, could we please have

a few more samples (and expected results) to show the sorts of variation (or lack of) that might occur with your data. XL2BB would be really good.

a = Evaluate(Replace("-right(substitute(#,""£"",rept("" "",20)),20)", "#", .Address(External:=True)))
a = Evaluate(Replace("iferror(-right(substitute(#,""£"",rept("" "",20)),20),"""")", "#", .Address(External:=True)))

 

[Liam4567]

You still haven't given us the desired resultant data/layout but see if this change does what you want.
If it doesn't, could we please have

a = Evaluate(Replace("-right(substitute(#,""£"",rept("" "",20)),20)", "#", .Address(External:=True)))
a = Evaluate(Replace("iferror(-right(substitute(#,""£"",rept("" "",20)),20),"""")", "#", .Address(External:=True)))

Sorry I see what you are after now.

That change has worked in the sense that it now pulls through all the numbers, however I just want one number to be pulled through. I have uploaded a screenshot of how I would like the data to be extracted, compared to how it is currently extracting.

The desired extract would be pulling through only the one figure after Option 4 into cell D2 on a separate sheet.

However what it currently does is loop through the entire column A and extracts any figure it finds into the specified column on the specified sheet.

So I literally only need the one figure after Option 4, all the rest can be ignored.

I hope this makes a bit more sense, sorry if this still isn't the information you're after?

 

[Peter_SSs]

The desired extract would be pulling through only the one figure after Option 4 into cell D2 on a separate sheet.

So there will only be one cell in column A containing "Option 4"?

Edit:
If so, do you really need vba for this or would a formula like this do?

=-RIGHT(SUBSTITUTE(VLOOKUP("*Option 4*",PDF!A1:A1000,1,0),"£",REPT(" ",20)),20)