RSMEANS Python REGEXP extractions

Attribute VB_Name = "RSUnits"

Option Explicit

''Constants for reference of unit types in RSMEANS

'' Floor, concrete, slab form, open web bar joist @ 2' OC, on W beam and wall, 30'x30' bay, 29" deep, 65 PSF superimposed load, 110 PSF total load, for columns add

Public Const VBQT = """"

''these use named regexp returns based in python

''Public Const Regex_BAY+PYTHON = "(?:(?P\d{1,})((?P\'|\" & VBQT & "|ft|in))\W{0,}x\W{0,}(?P\d{1,})(?P\'|\" & VBQT & "|ft|in)\W{0,}bay)"

Public Const Regex_BAY = "(?:([\d\.]{1,})((\'|\" & VBQT & "|ft|in))\W{0,}x\W{0,}(\d{1,})(\'|\" & VBQT & "|ft|in)\W{0,}bay)"

Public Const Regex_Addon = "(?:for\W{0,}(?P\b.+\b)\W{0,}add)\W{0,}"

''Public Const Regex_SPACE+python = "(?:.+,(?P.+?)(\@\W{0,}(?P\d{1,})((?P\'|\" & VBQT & "|ft|in)\W{0,}oc)))"

Public Const Regex_SPACE = "(?:.+,(.+?)(\@\W{0,}([\d\.]{1,})((\'|\" & VBQT & "|ft|in)\W{0,}oc)))"

Public Const Regex_SPAN = "(?:.+,(.+?)(\@\W{0,}([\d\.]{1,})((\'|\" & VBQT & "|ft|in)\W{0,}span)))"

''Public Const Regex_DEEP+PYTHON  = "(?:(?P\d{1,})(?P\'|\" & VBQT & "|ft|in)\W{0,}deep)"

Public Const Regex_DEEP = "(?:([\d\.]{1,})(\'|\" & VBQT & "|ft|in)\W{0,}deep)"

Public Const Regex_LOAD = "(?:(?P\d{1,})\W{0,}(?P(P[S|L]F))\W{0,}(?P\w{1,12})\W{0,}load)"

'' full regexp with names regexp =  watch for VBQTs!

'' (?:(?P\d{1,})((?P\'|\"|ft|in))\W{0,}x\W{0,}(?P\d{1,})(?P\'|\"|ft|in)\W{0,}bay)|(?:for\W{0,}(?P\b.+\b)\W{0,}add)\W{0,}|(?:.+,(?P.+?)(\@\W{0,}(?P\d{1,})((?P\'|\"|ft|in)\W{0,}oc)))|(?:(?P\d{1,})(?P\'|\"|ft|in)\W{0,}deep)|(?:(?P\d{1,})\W{0,}(?P(P[S|L]F))\W{0,}(?P\w{1,12})\W{0,}load)

Type Units

    BAY_X As Integer

    BAY_Y As Integer

    BAY_X_UNIT As String

    BAY_Y_UNIT As String

End Type

Function RSM_Val(strValue As String, Optional strType As String) As Variant

Dim rangeCaller As Range

Dim reg As New Regexp

Dim strl As String

Dim ret As MatchCollection

Dim strNumberFormat As String

''only returns one value at a time so only need to track one measurement except wxd for 'bay'

Dim Height As Single

Dim Width As Single

Dim Depth As Single

Dim UNIT As String

Dim Found As Boolean        ''for control over formatting

Found = False

    strl = LCase(strValue)

    strType = LCase(strType)

    Set rangeCaller = Application.Caller

   

    Select Case strType

        Case "bay"

            reg.Pattern = RSUnits.Regex_BAY

       

            Set ret = reg.Execute(strValue)

            If ret.Count > 0 Then

                Width = ret.Item(0).SubMatches.Item(0)

                If ret.Item(0).SubMatches.Item(1) = VBQT Then ret.Item(0).SubMatches.Item(1) = "''"  ''may not be needed returning text.

                Depth = ret.Item(0).SubMatches.Item(3)

                If ret.Item(0).SubMatches.Item(4) = VBQT Then ret.Item(0).SubMatches.Item(4) = "''"  ''may not be needed returning text.

               

                RSM_Val = Width & ret.Item(0).SubMatches.Item(1) & " x " & Depth & ret.Item(0).SubMatches.Item(4)

                UNIT = "General"

               

                rangeCaller.Cells(1, 1).HorizontalAlignment = xlCenter

                rangeCaller.Cells(1, 1).VerticalAlignment = xlCenter

                Found = True

            End If

        Case "bayx"

            reg.Pattern = RSUnits.Regex_BAY

       

            Set ret = reg.Execute(strValue)

            If ret.Count > 0 Then

                Width = ret.Item(0).SubMatches.Item(0)

                UNIT = ret.Item(0).SubMatches.Item(1)

                Depth = ret.Item(0).SubMatches.Item(3)

                strNumberFormat = "00" & VBQT & UNIT & VBQT

               

                RSM_Val = Width

               

                rangeCaller.Cells(1, 1).HorizontalAlignment = xlRight

                Found = True

            End If

        Case "bayy"

            reg.Pattern = RSUnits.Regex_BAY

       

            Set ret = reg.Execute(strValue)

            If ret.Count > 0 Then

                Depth = ret.Item(0).SubMatches.Item(3)

                UNIT = ret.Item(0).SubMatches.Item(4)

                RSM_Val = Depth

                rangeCaller.Cells(1, 1).HorizontalAlignment = xlRight

                Found = True

            End If

           

        Case "deep"

            reg.Pattern = RSUnits.Regex_DEEP

       

            Set ret = reg.Execute(strValue)

            If ret.Count > 0 Then

                Height = ret.Item(0).SubMatches.Item(0)

                UNIT = ret.Item(0).SubMatches.Item(1)

                RSM_Val = Height

                Found = True

            End If

       

    End Select

    If Found = True Then                                                '''Reset formatting

        FormatCell Application.Caller, UNIT

    Else                                                                ''''reset cell to general formatting

        RSM_Val = ""

        rangeCaller.NumberFormat = "General"

        rangeCaller.HorizontalAlignment = xlTop

        rangeCaller.VerticalAlignment = xlLeft

    End If

       

End Function

Private Sub FormatCell(xr As Range, UNIT As String)

Select Case UNIT

    Case VBQT, "''" ''inches

        UNIT = "00.00" & "''"

    Case "'"

        UNIT = "00" & "'"

    Case Else

        UNIT = "General"

End Select

    Sheet1.strNumberFormat = UNIT   ''trick to attempt force override on sheet value change

    xr.NumberFormat = UNIT

End Sub