Solved

Modifying functions to handle 3 different scenarios at once

Posted on 2011-09-26
7
289 Views
Last Modified: 2012-05-12
Please take a look at the attached workbook and let me know if there is a way to accomodate situations in which all three of the scenarios, described in the two functions below, appear in one cell.

Thanks,
John
Function GetSeatsABC(InputCell As Range) As String
    Dim RegEx, RegM, RegMC
    Dim MyDic
    Dim tmpStr As String
    Dim i As Long
    Set MyDic = CreateObject("scripting.dictionary")
    Set RegEx = CreateObject("vbscript.regexp")
    With RegEx
        .Pattern = "(?:ROW|seat)(S)?\s*(\d+)\s*\w*\s*([,-/|]|to| |thru|through)\s*\w{0,5}?\s*(\d+)"
        .Global = True
        .IgnoreCase = True
        If .test(InputCell.Value) Then
            Set RegMC = .Execute(InputCell)
            For Each RegM In RegMC
                If MyDic.exists(LCase$(RegM)) = False Then

                    For i = RegM.submatches(1) To RegM.submatches(3)
                            tmpStr = tmpStr & i & cells(InputCell.Row, [SeatColumnCounts].Column) & " | "
                    Next
                    tmpStr = Left$(tmpStr, Len(tmpStr) - 2)
                    MyDic.Add LCase$(RegM), 1
                End If
            Next
        End If
        .Pattern = "\d{1,3}[ /-]?(?!jan|feb|apr|ma[ry]|ju[ln]|aug|sep|oct|nov|dec|in|by|mi|hrs|AVOD|check|GMT|jump|and|dtd|fail|area|headset)[A-M]+"           'TerryAtOpus
        If .test(InputCell.Value) Then
            Set RegMC = .Execute(InputCell)
            For Each RegM In RegMC
                If tmpStr = vbNullString Then
                    tmpStr = RegM
                Else
                    tmpStr = tmpStr & " | " & RegM
                End If
            Next
        End If
GetSeatsABC = tmpStr
    End With
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetSeats(InputCell As Range) As String
    Dim RegEx, RegM, RegMC
    Dim MyDic
    Dim tmpStr As String
    Dim i As Long
    Set MyDic = CreateObject("scripting.dictionary")
    Set RegEx = CreateObject("vbscript.regexp")
    With RegEx
.Pattern = "(?:ROW|SEAT)(S)?\s*(\d+)\s*([,-/|]|to|thru|through|til|till)\s*(\d+)"
.Global = True
.IgnoreCase = True
        If .test(InputCell.Value) Then
            Set RegMC = .Execute(InputCell)
            For Each RegM In RegMC
                If MyDic.exists(LCase$(RegM)) = False Then
                    For i = RegM.submatches(1) To RegM.submatches(3)
                        Select Case i
                        Case Is <= cells(InputCell.Row, [J_Hi].Column)
                            tmpStr = tmpStr & i & cells(InputCell.Row, [SeatsAcrossJ].Column) & " | "
                        Case Is <= cells(InputCell.Row, [B_Hi].Column)
                            tmpStr = tmpStr & i & cells(InputCell.Row, [SeatsAcrossB].Column) & " | "
                        Case Is <= cells(InputCell.Row, [Y_Hi].Column)
                        tmpStr = tmpStr & i & cells(InputCell.Row, [SeatsAcrossY].Column) & " | "
                        Case Else
                            tmpStr = tmpStr & i & cells(InputCell.Row, [SeatsAcrossY2].Column) & " | "
                        End Select
                    Next
                    
                MyDic.Add LCase$(RegM), 1
                End If
            Next
            tmpStr = Left$(tmpStr, Len(tmpStr) - 2)
        End If
.Pattern = "\d{1,3}[ /-]?(?!jan|feb|apr|ma[ry]|ju[ln]|aug|sep|oct|nov|dec|in|by|mi|hrs|AVOD|check|GMT|jump|and|dtd|fail|area|headset)[A-M]+"  
        If .test(InputCell.Value) Then
            Set RegMC = .Execute(InputCell)
            For Each RegM In RegMC
                If tmpStr = vbNullString Then
                    tmpStr = RegM
                Else
                    tmpStr = tmpStr & " | " & RegM
                End If
            Next
        End If
GetSeats = tmpStr
    End With
End Function

Open in new window

GetSeats.xlsm
0
Comment
Question by:gabrielPennyback
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 4
  • 2
7 Comments
 
LVL 17

Expert Comment

by:andrewssd3
ID: 36710540
Could you please give some more detail about the three scenarios and some explanation of how you arrive at the values you're expecting to see in AD7 and AD11?  I suspect the reason this hasn't been answered yet is that you're asking quite a lot for people to dive in and fully understand what's happening without any background information.
0
 
LVL 1

Author Comment

by:gabrielPennyback
ID: 36719728
Hi andrewssd3, thanks for posting. Please let me know if the revised workbook gives you enough to go on.

Thanks,
John
GetSeats-v2.xlsm
0
 
LVL 17

Expert Comment

by:andrewssd3
ID: 36720067
Thanks for clarifying.  I'll take a look at this as soon as I can.  But it's nearly my bedtime now...
0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 17

Accepted Solution

by:
andrewssd3 earned 500 total points
ID: 36816034
Hi John - I've had a first shot at this, and written a new function that does everything in one go - GetSeatsNew.  I've basically used the regex patterns you had with small amendments, so I haven't reinvented the complex one that identifies individual seats, except to add a couple of submatches.  I've tried to put in some comments to make it easier to change next time.

The change to the formula is that it requires the ranges of row allocation per class (CC:CL) and seats per row (CU:CY). I did this so that Excel will recalculate the formula whenever there are changes either to the incident strings or to the seat allocation - previously you would have had to reenter the formulas if there was a change to seat allocation.

I have stripped out all your other code from this sample, but you can drag the new calcSeats module into your version if you like it. I think the button to calc the seat clusters is now redundant, as column BT isn't now used.

Let me know what you think.  I've put the main function code inline here, but there are a couple of extra help functions in the file I've attached.
Cheers
Stuart

Function GetSeatsNew(ByRef InputCell As Excel.Range, _
                        ByRef rowAssignments As Excel.Range, _
                        ByRef rowSeats As Excel.Range _
                        ) As String
'---------------------------------------------------------------------------------------
' Procedure : GetSeatsNew
' DateTime  : 29/09/2011 14:45
' Author    : andrewssd3 - EE
' Desc      : inputCell is the incident string from which we will extract the seat info
'             rowAssigments is the range indicating what row belongs in what class
'                           - there will be 2 cols (start and end range) per class
'             rowSeats specifies the seats available in each class - must have half
'                           as many columns as rowAssignments
'---------------------------------------------------------------------------------------
'
    Dim RegEx As Object, RegM As Object, RegMC As Object
    Dim MyDic As Object
    Dim tmpStr As String
    Dim i As Integer
    Dim intRowFirst As Integer, intRowLast As Integer
    
    Dim intMaxRows As Integer
    Dim aRows() As String
    
    Dim strPartialRow As String
    Dim strRowSeats As String
    Dim strSearch As String
    
    Const cstrPattSeatRange As String = _
"(?:ROW|seat)(?:S)?\s*(\d+)\s*([A-M]*)\s*([,-/|]|to| |thru|through)\s*\w{0,5}?\s*(\d+)\s*([A-M]*)"
'Submatches-----------( 0 )---( 1    )---(            2           )--------------( 3 )---( 4    )
' (0) - first row
' (1) - row seats (optional, but should not be present with (4))
' (2) - range indicator (not used currently)
' (3) - last row
' (4) - row seats (optional, but should not be present with (1))

    Set MyDic = CreateObject("scripting.dictionary")
    Set RegEx = CreateObject("vbscript.regexp")
    
    intMaxRows = Application.WorksheetFunction.max(rowAssignments)
    ReDim aRows(1 To intMaxRows)
    
    strSearch = InputCell.Value
    
    With RegEx
        .Pattern = cstrPattSeatRange
        .Global = True
        .IgnoreCase = True
        If .test(strSearch) Then
            Set RegMC = .Execute(InputCell)
            For Each RegM In RegMC
                intRowFirst = RegM.submatches(0)
                intRowLast = RegM.submatches(3)
                ' partial seat info for the row should be either after the firs row,
                ' or after the last - so if both a present, use the first and ignore the last
                strPartialRow = _
                    IIf(Len(RegM.submatches(1)) > 0, RegM.submatches(1), RegM.submatches(4))
                ' if no partial row info was found, get all seats for these rows
                
                ' for each row, get the row seats for this row if it is a full row, then
                ' merge the seats with any already found for this row
                For i = intRowFirst To intRowLast
                    If Len(strPartialRow) = 0 Then
                        strRowSeats = GetSeatsForRow(i, rowAssignments, rowSeats)
                    Else
                        strRowSeats = strPartialRow
                    End If
                    If strRowSeats <> aRows(i) Then     ' if not already added all these seats
                        aRows(i) = MergeSeats(aRows(i), strRowSeats)
                    End If
                Next i
                ' blank out this find to prevent it from confusing the search for inividual seats
                Mid$(strSearch, RegM.firstindex + 1, RegM.Length) = String(RegM.Length, "~")
            Next RegM
        End If
        
        ' search for individual seats
        .Pattern = "(\d{1,3})[ /-]?(?!jan|feb|apr|ma[ry]|ju[ln]|aug|sep|oct|nov|dec|in|by|mi|hrs|AVOD|check|GMT|jump|and|dtd|fail|area|headset)([A-M]+)"           'TerryAtOpus
        If .test(strSearch) Then
            Set RegMC = .Execute(InputCell)
            For Each RegM In RegMC
                i = RegM.submatches(0)
                strRowSeats = RegM.submatches(1)
                If strRowSeats <> aRows(i) Then     ' if not already added all these seats
                    aRows(i) = MergeSeats(aRows(i), strRowSeats)
                End If
            Next
        End If
    End With
    
    ' build the return string by looping through the rows array and outputting
    ' all rows that have been touched
    tmpStr = vbNullString
    For i = 1 To UBound(aRows)
        If Len(aRows(i)) > 0 Then
            If Len(tmpStr) > 0 Then
                tmpStr = tmpStr & " | " & CStr(i) & aRows(i)
            Else
                tmpStr = CStr(i) & aRows(i)
            End If
        End If
    Next i
    
    GetSeatsNew = tmpStr
End Function

Open in new window

GetSeats-v2.xlsm
0
 
LVL 17

Expert Comment

by:andrewssd3
ID: 36954584
John - I put in quite bit of work on this for you a couple of weeks ago, and I think it was a pretty good solution - have you had a chance to test it yet (and maybe allocate some points :))

Stuart
0
 
LVL 1

Author Closing Comment

by:gabrielPennyback
ID: 37097015
Hi Stuart, I've been on vacation since October 28 and in the usual pre-vacation madness I forgot to close this question, please accept my apologies. And thank you for your answer!

alias99, thanks for clarifying the Ask a Related Question procedure, I'll definitely do this in the future.

- John
0

Featured Post

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying 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

This article descibes how to create a connection between Excel and SAP and how to move data from Excel to SAP or the other way around.
This article describes how you can use Custom Document Properties to store settings and other information in your workbook so that they will be available the next time you open the workbook.
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.

696 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