Solved

Modifying functions to handle 3 different scenarios at once

Posted on 2011-09-26
7
244 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
  • 4
  • 2
7 Comments
 
LVL 17

Expert Comment

by:andrewssd3
Comment Utility
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
Comment Utility
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
Comment Utility
Thanks for clarifying.  I'll take a look at this as soon as I can.  But it's nearly my bedtime now...
0
Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

 
LVL 17

Accepted Solution

by:
andrewssd3 earned 500 total points
Comment Utility
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
Comment Utility
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
Comment Utility
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

How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

Join & Write a Comment

A2 = A1 That kind of cell reference is relative.  If you copy it from A2 to B2, then B2 will get this: B2 = B1 That's all fine and good, but if you then insert a new row above row 2, you'll find: A3 = A1 B3 = B1 This is intentional. …
Introduction While answering a recent question (http:/Q_27311462.html), I created an alternative function to the Excel Concatenate() function that you might find useful.  I tested several solutions and share the results in this article as well as t…
The viewer will learn how to simulate a series of sales calls dependent on a single skill level and learn how to simulate a series of sales calls dependent on two skill levels. Simulating Independent Sales Calls: Enter .75 into cell C2 – “skill leve…
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.

772 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

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now