Extract data after "-" VBA

Liam4567

New Member
Joined
Jan 6, 2021
Messages
6
Office Version
  1. 365
Platform
  1. Windows
**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.
 

Excel Facts

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
49,244
Office Version
  1. 365
Platform
  1. Windows
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

New Member
Joined
Jan 6, 2021
Messages
6
Office Version
  1. 365
Platform
  1. Windows
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

Active Member
Joined
Jan 24, 2003
Messages
450
Office Version
  1. 2013
Platform
  1. Windows
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

VBA Code:
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

Active Member
Joined
Jan 24, 2003
Messages
450
Office Version
  1. 2013
Platform
  1. Windows

ADVERTISEMENT

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

VBA Code:
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

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
49,244
Office Version
  1. 365
Platform
  1. Windows
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.

VBA Code:
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

New Member
Joined
Jan 6, 2021
Messages
6
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

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.

VBA Code:
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.
 

Attachments

  • Data Example.JPG
    Data Example.JPG
    18.3 KB · Views: 6

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
49,244
Office Version
  1. 365
Platform
  1. Windows
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.

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

Liam4567

New Member
Joined
Jan 6, 2021
Messages
6
Office Version
  1. 365
Platform
  1. Windows
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


Rich (BB code):
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?


DesiredExtract.JPG
Current Extract.JPG
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
49,244
Office Version
  1. 365
Platform
  1. Windows
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?

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

Watch MrExcel Video

Forum statistics

Threads
1,133,828
Messages
5,661,152
Members
418,619
Latest member
ibruzzi

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top