CODEWITHSUNDEEP
excelvba
user1624926
user1624926

Reputation: 451

Location of cell and Extract numeric value

I'm currently "trying" to setup a grid in Excel where

I have started to play with the code below. In the section msgbox("work") - I'm using just to test code around it. Here I want to return the numeric value in the cell and the cell location so I can put them onto a report.

Any help would be greatly appreciated.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rng As Range
Dim rngTarget As Range

Set rngTarget = Range("a1:a100")    
If Not Intersect(Target, Range("A1:A100")) Is Nothing Then        
    For Each rng In rngTarget   
        If InStr(1, prNg, "H") > 0 And InStr(1, rngEachValue, "P") = 0 Then
               MsgBox ("works")            
        End If    
    Next    
End If    

End Sub

Upvotes: 3

Views: 759

Answers (2)

K_B
K_B

Reputation: 3678

I found this a nice question so put some work into the answer. I think this will do just what you want! It even works with decimal and thousand separators.

I do admit the NumericalValue function could be created in a different way as well (find the first and the last number and take that mid part of the string.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng As Range
    Dim rngTarget As Range
    Dim varValue As Variant

    Set rngTarget = Range("a1:a100")

    If Not Intersect(Target, rngTarget) Is Nothing Then
        For Each rng In rngTarget
            'only check cells that contain an H and a P
            If InStr(1, rng, "H") > 0 And InStr(1, rng, "P") > 0 Then
                'find the numerical value if any (Empty if not found)
                varValue = NumericalValue(rng.Value2)
                If Not IsEmpty(varValue) Then
                    MsgBox "hurray the value of cell " & rng.AddressLocal & " is " & varValue
                End If
            End If
        Next
    End If

End Sub

'return the first numerical value found in the cell
Private Function NumericalValue(ByVal strValue As String) As Variant
    Dim intChar As Integer
    Dim booNumberFound As Boolean
    Dim intDecimal As Integer

    booNumberFound = False

    NumericalValue = Val(strValue)

    For intChar = 1 To Len(strValue) Step 1
        'if a number found then grow the total numerical value with it
        If IsNumeric(Mid(strValue, intChar, 1)) Then
            NumericalValue = NumericalValue * IIf(intDecimal = 0, 10, 1) + _
                    Val(Mid(strValue, intChar, 1)) * 10 ^ -intDecimal
            If intDecimal > 0 Then
                intDecimal = intDecimal + 1
            End If
            booNumberFound = True
        'if the decimal separator is found then set the decimal switch
        ElseIf intDecimal = 0 And booNumberFound = True And Mid(strValue, intChar, 1) = Application.DecimalSeparator Then
            intDecimal = 1
        'skip the thousand separator to find more numbers
        ElseIf booNumberFound = True And Mid(strValue, intChar, 1) = Application.ThousandsSeparator Then
        ElseIf booNumberFound = True Then
            Exit For
        End If
    Next intChar

End Function

Upvotes: 4

Our Man in Bananas
Our Man in Bananas

Reputation: 5981

you're most of the way there, try the below:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rng As Range
Dim rngTarget As Range
Dim sText As String

Set rngTarget = Range("a1:a100")

If Not Intersect(Target, Range("A1:A100")) Is Nothing Then    
    For Each rng In rngTarget        
        If InStr(1, rng.Text, "H") > 0 And InStr(1, rng.Text, "P") > 0 Then    
            sText = rng.Text
            sText = Replace(sText, "H", "")
            sText = Replace(sText, "P", "")
            Debug.Print rng.Address & " = " & Val(sText)   
        End If    
    Next    
End If

End Sub

Upvotes: 1

Related Questions