Get values from a string

Posted on 2013-01-31
Last Modified: 2013-01-31
i am trying to get values from long strings of different lengths in a listbox;

Win Runs: 7329 high dollar amount 41.25 low credit $12.47 Result $41.48
Loss Runs: 6856 high dollar amount 25.80 low credit $40.52 Result $40.52
Win Runs: 136 high dollar amount 40.75 low credit $13.47 Result $40.52
Win Runs: 1354 high dollar amount 40.25 low credit $15.47 Result $40.00
Loss runs 13111 high dollar amount 35.80 low credit $41.48 Result $41.48

I am trying to addup all the runs eg:7329+6856+136+1354+13111 = 28,786
Low Credit $12.47+$40.52+$13.47+$15.47+$41.48 = 107.94
How can this be done?
Question by:isnoend2001

Accepted Solution

Rahul_Gade earned 500 total points
ID: 38842525
Hope this funciton "GetNumAfter" will help:

Sub main()
Dim str As String
Dim run As String
str = "Win Runs: 7329 high dollar amount 41.25 low credit $12.47 Result $41.48"
runs = GetNumAfter(str, "Runs: ")
amount = GetNumAfter(str, "amount ")
credit = GetNumAfter(str, "credit $")
result = GetNumAfter(str, "Result $")
End Sub

Public Function GetNumAfter(MainString As String, SearchString As String)
Dim ResultValue As String
Dim pos1 As Integer
Dim pos2 As Integer
pos1 = InStr(MainString, SearchString) + Len(SearchString)
pos2 = InStr(pos1, MainString, " ")
If (pos2 = 0) Then pos2 = Len(MainString) + 1
ResultValue = Mid(MainString, pos1, pos2 - pos1)
GetNumAfter = ResultValue
End Function

Author Closing Comment

ID: 38842560
good job thanks
LVL 14

Expert Comment

ID: 38842572
Copy your source strings to a worksheet starting from A1.
Place this code in a normal code module and run the Sub Test
Option Explicit
Option Base 0

Private Sub Test()
    Const Col As String = "A"   ' column where the source strings are
    Dim Ws As Worksheet
    Dim Temp As String          ' Source string
    Dim S() As String           ' subdivided Source string
    Dim R As Long               ' Row number
    Dim Numbers() As Double     ' numbers extracted from the source string
    Dim i As Long
    Set Ws = ActiveSheet
    With Ws
        For R = 1 To LastRow(Col, Ws)
            Temp = .Cells(R, Col).Value
            Temp = Application.WorksheetFunction.Substitute(Temp, Chr(160), Chr(32))
            S = Split(Temp)
            Numbers = ExtractedNumbers(S)
            MsgBox S(0) & " = " & Numbers(0) & vbCr & _
                   "High dollar amount = " & Numbers(1) & vbCr & _
                   "Low credit = " & Numbers(2) & vbCr & _
                   "Result = " & Numbers(3)
        Next R
    End With
End Sub

Private Function ExtractedNumbers(S() As String) As Double()

    Dim Numbers(0 To 3) As Double   ' numbers extracted from the source string
    Dim n As Long                   ' array index
    Dim i As Long                   ' array index
    Dim Temp As String
    For n = 0 To UBound(S)
        Temp = Trim(S(n))
        If Left(Temp, 1) = "$" Then
            Temp = Trim(Mid(Temp, 2))
        End If
        If IsNumeric(Temp) Then
            Numbers(i) = Val(Temp)
            i = i + 1
        End If
    Next n
    ExtractedNumbers = Numbers
End Function

Private Function LastRow(Optional ByVal Col As Variant, _
                         Optional Ws As Worksheet) As Long
    ' 0059 V 3.2 Apr 2, 2012

    ' Return the number of the last non-blank row in column Col.
    ' Specify the column as string or number
    ' If no column is specified,
      ' return the last row from column A.
    ' If no worksheet is specified
      ' return the result from the currently active sheet.
    Dim R As Long
    If Ws Is Nothing Then Set Ws = ActiveSheet
    If VarType(Col) = vbError Then Col = 1
    With Ws
        R = .Cells(.Rows.Count, Col).End(xlUp).Row
        With .Cells(R, Col)
            ' in a blank column the last used row is 0 (= none)
            If R = 1 And .Value = vbNullString Then R = 0
            ' include all rows of a merged range
            LastRow = R + .MergeArea.Rows.Count - 1
        End With
    End With
End Functio

Open in new window

The code extracts the numbers but doesn't total them up. I think doing the total will not be a problem for you. I also think that you will be able to read the code I am providing,. Should you need assistance, however, please do let me know.
LVL 15

Expert Comment

ID: 38842672
You can try this also:

  Dim s As String
  Dim n As Long
  Dim nRuns As Double
  Dim nLowC As Currency
  For n = 0 To List1.ListCount - 1
      s = List1.List(n)

      nRuns = nRuns + Val(Split(s, "Runs:", 2)(1))
      nLowC = nLowC + Val(Split(s, "low credit $", 2)(1))
  Debug.Print nRuns, Format(nLowC, "$###,###.##")

Open in new window


Featured Post

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction While answering a recent question ( in the VB classic zone, I wrote some VB code in the (Office) VBA environment, rather than fire up my older PC.  I didn't post completely correct code o…
If you have ever used Microsoft Word then you know that it has a good spell checker and it may have occurred to you that the ability to check spelling might be a nice piece of functionality to add to certain applications of yours. Well the code that…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…

792 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question