Extracting numbers from multiple cells in a range

[flying_rock27]

So I need to extract numbers from multiple cells withing a range, having added them up. The current extract number function I found only works for one cell at a time.

Function ExtractNumber(Target As Range) As Variant
Dim i As Integer
Dim str1 As String
For i = 1 To Len(Target)
If IsNumeric(Mid(Target, i, 1)) Then
str1 = str1 + Mid(Target, i, 1)
End If
Next i
ExtractNumber = str1
End Function

Not only that, but I need to extract and add only the ones that are in <>. For example,
Homework#3 <Numeric MaxPoints:10>, I only need the 10. However, I'd be more than gratefully if someone only helped me with my first task. Thanks to anyone in advance (Also, I'm a noob here ^^', so please pardon any rudeness I gave)

 

[mikerickson]

If you write the function to return an array, a formula like

=SUM(ExtractNumber(A1:D4)) can be used to sum a range of values.

Function ExtractNumber(Target As Range) As Variant
    Dim resultArray As Variant
    Dim rRow As Long, rColumn As Long
    Dim i As Integer
    Dim str1 As String, str2 As String
    
    If Target.Cells.Count = 1 Then
        ReDim resultArray(1 To 1, 1 To 1)
    Else
        resultArray = Target.Value
    End If
    
    For rRow = 1 To Target.Rows.Count
        For rColumn = 1 To Target.Columns.Count
            str2 = CStr(Target.Cells(rRow, rColumn).Value)
            str1 = vbNullString
            For i = 1 To Len(str2)
                If IsNumeric(Mid(str2, i, 1)) Then
                    str1 = str1 & Mid(str2, i, 1)
                End If
            Next i
            
            resultArray(rRow, rColumn) = Val(str1)
        Next rColumn
    Next rRow
    
    ExtractNumber = resultArray
End Function

 

[flying_rock27]

So I took what you gave me, and my friend and I finally managed to create the code below. However, and this might be more with Excel/VBA issues, when I select the range, it sometimes just gives:

Run-time error '13':
Type mismatch

Here are examples of what I'm selecting for ranges (each in their own cell):

Extra Credit Assignments Points Grade <numeric maxpoints:1="">

Extra Credit Assignments Scheme Symbol

When selected individually, the code works smoothly. When selected as a single range, I get the Run-time error.

I have no earthly idea as to why it's doing this.


Code:

<numeric>
Function ExtractNumber(Target As Range) As Long

Dim Cell As Range
Dim intFirstChar As Integer
Dim intLastChar As Integer
Dim intCharacter As Integer
Dim strNumber As String


If Target Is Nothing Then
ExtractNumber = 0
Exit Function
Else
GoTo 10
End If
10 If Target.Find("<") Is Nothing Then
ExtractNumber = 0
Exit Function
Else
GoTo 20
End If
20
'For-Each loop iterates through all cells in range Target
For Each Cell In Target.Cells

'if position of "<" in text > 0 then startin position for
'search = "<" position + 1, else start position = 1
If InStr(1, Cell, "<") > 0 Then
intFirstChar = InStr(1, Cell, "<") + 1
Else: intFirstChar = 1
End If

'if position of ">" in text > intFirstChar then end position for
'search = ">" position - 1, else end position = last character
If InStr(1, Cell, ">") > intFirstChar Then
intLastChar = InStr(1, Cell, ">") - 1
Else: intLastChar = Len(Cell)
End If

'search characters between intFirstChar and intLastChar
For intCharacter = intFirstChar To intLastChar
If IsNumeric(Mid(Cell, intCharacter, 1)) Then
strNumber = strNumber + Mid(Cell, intCharacter, 1)
End If
Next

'add number found in current cell to ExtractNumber
ExtractNumber = ExtractNumber + CLng(strNumber)
'set strNumber to empty string
strNumber = ""

Next

End Function</numeric>

 

[mikerickson]

If you could post a small representative sample of your data and the desired result, that would help.

 

[flying_rock27]

Sorry for the delayed response. I was able to work around "type mismatch" by

Dim Epic As Integer
....
code
.....

Epic = Val(strNumber)

ExtractNumber = ExtractNumber + Epic

strNumber = ""

Next

End Function

I have a new dilemma, though. I'll attach a sample as you've asked.

As this is a big part of a school project, I don't mind just receiving guiding advice instead of the code that would make it work.

What I need to do is:

The Extract Number was meant to be the Total Points Possible in the category.

Each cell with a <> represents the total points possible of that assignment. I know in order to find how much each assignment affects the total grade (the Weight of the assignment), I divide each assignment by the Total Points Possible.

From there, I take the percentage the student got on that assignment minus the Weight of the assignment to get a new number. I do this for each assignment.

I organize the new numbers in order and drop the x lowest, x being a number the User puts in earlier in the program.

Later on, I need to put "-drop" on the assignments that were dropped within the worksheet, so I'll need to recall them in some way.

I know this will involve For-Each loops, but I can't see how with my current knowledge, as my thinking involves setting each Assignment weight to an object, but I know without knowing how many cells there are going to be, this is impossible.

Also, blanks are zero's. However, if an entire column is blank, then it can be ignored.

The workbook attached is simply one "Category" that is on the example that was given to us.

It is saved as Macro-Enabled, so it will run as soon as it's opened.

http://www.4shared.com/file/bSkTM23I/Sample_Code.html

Thank you!

 

[mikerickson]

if you use Excel Jeanie to post a representative sample of your data, it sounds possible that a non-VB solution can be found.

(Non-VBA solutions are generally faster and more robust. If this is a school project, VBA may be requried. But the layout of your data is still crucial.)