Avatar of Frank .S
Frank .S
Flag for Australia asked on

Excel 2010 - Cell Value Addition & Transfer2

Hi experts/ Brad
Id like to make some adjustments (conditions) to the source code of the previous workbook please: https://www.experts-exchange.com/Q_28072893.html
1. If there is no entry in col "D" then nothing is to be shown in col "E"
2. If there is only a text entry in col "D" then nothing is to be shown in col "E"
3. If there are 2 values in col "D" ie
porch 2.00L x 5.00W
alfresco 3.00L x 3.00W

then col "E" multiplies these 2 values, then adds the total of them so, the result would be 10.00 + 9.00 (the result of the porch + alfresco) = 19.00
4. I have found a problem where if i enter the following information;
Front: 10.56 m2
Rear Garage: 5.28 m2
Rear Pedestrian: 1.67 m2
The result should = 17.51, but instead = 23.51, please adjust code so that if there is an "m" followed by a number it does not add the value
Microsoft Excel

Avatar of undefined
Last Comment
byundt

8/22/2022 - Mon
byundt

In the earlier question, you were using / to indicate multiplication, and x was basically ignored. Your request 3 is contrary to that.

Except for that issue, you might consider:
Function AddItUp(s As String) As Variant
Dim RgExp As Object, oMatches As Object, oMatch As Object
Dim i As Long
Dim d1 As Double, dSum As Double
Set RgExp = CreateObject("VBScript.RegExp")
With RgExp
    .Global = True
    .Pattern = "((\d+)(\.?)(\d*)/)|((\d+)(\.?)(\d*))"    '"(/)?(/s*)(/d*)(/.)?(/d*)"
    s = Replace(s, "m2", "")
    s = Replace(s, "M2", "")
    Set oMatches = .Execute(s)
    i = oMatches.Count
    For Each oMatch In oMatches
        If InStr(1, oMatch, "/") > 0 Then
            d1 = Val(oMatch)
        Else
            If d1 <> 0 Then
                dSum = dSum + d1 * oMatch.Value
                d1 = 0
            Else
                dSum = dSum + oMatch.Value
            End If
        End If
    Next
End With
Set oMatch = Nothing
Set oMatches = Nothing
Set RgExp = Nothing
AddItUp = IIf(dSum <> 0, dSum, "")
End Function

Open in new window

Brad
byundt

I've added the ability to handle case 3.
Function AddItUp(s As String) As Variant
Dim RgExp As Object, oMatches As Object, oMatch As Object
Dim i As Long
Dim d1 As Double, dSum As Double
Set RgExp = CreateObject("VBScript.RegExp")
With RgExp
    .Global = True
    .Pattern = "((\d+)(\.?)(\d*)((/)|\s?([A-Za-z]{0,6}\s+x\s+)))|((\d+)(\.?)(\d*))"
    s = Replace(s, "m2", "")
    s = Replace(s, "M2", "")
    Set oMatches = .Execute(s)
    i = oMatches.Count
    For Each oMatch In oMatches
        If InStr(1, oMatch, "/") > 0 Then
            d1 = Val(oMatch)
        ElseIf Right(Trim(LCase(oMatch)), 1) = "x" Then
            d1 = Val(oMatch)
        Else
            If d1 <> 0 Then
                dSum = dSum + d1 * Val(oMatch)
                d1 = 0
            Else
                dSum = dSum + Val(oMatch)
            End If
        End If
    Next
End With
Set oMatch = Nothing
Set oMatches = Nothing
Set RgExp = Nothing
AddItUp = IIf(dSum <> 0, dSum, "")
End Function

Open in new window

Frank .S

ASKER
Thankyou Byundt, could you pls add to the worksheet and attach for me? I didnt save your original one and so i cant just copy and paste your new source code into the previous one.
Experts Exchange has (a) saved my job multiple times, (b) saved me hours, days, and even weeks of work, and often (c) makes me look like a superhero! This place is MAGIC!
Walt Forbes
ASKER CERTIFIED SOLUTION
byundt

Log in or sign up to see answer
Become an EE member today7-DAY FREE TRIAL
Members can start a 7-Day Free trial then enjoy unlimited access to the platform
Sign up - Free for 7 days
or
Learn why we charge membership fees
We get it - no one likes a content blocker. Take one extra minute and find out why we block content.
Not exactly the question you had in mind?
Sign up for an EE membership and get your own personalized solution. With an EE membership, you can ask unlimited troubleshooting, research, or opinion questions.
ask a question
Frank .S

ASKER
Hi Byundt, for some reason Ive clicked onto the link thats been posted many times and nothing happens? I'll keep trying.
byundt

I just tested the link, and it is working for me.