Solved

Need help with a RegEx function in Excel 2003

Posted on 2010-09-15
5
398 Views
Last Modified: 2012-05-10
Please take a look at the attached workbook. I need to replace the word "ActiveCell" in the RegEx function "GetSeats" so that it will calculate and re-calculate correctly for all cells containing the function. I tried using "InputCell," but that didn't work. I don't know enough about Regular Expressions to know what in the function code refers to the cell.

Also, when you have two row groupings in the cell being referenced by the function (such as ROWS 9-11, ROWS 35-36), there should be a comma between the resulting strings, but there isn't.

Thanks,
John
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(S)? (\d+)-(\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(2)
                        Select Case i
                        Case Is <= ActiveCell.Offset(0, 96)
                            tmpStr = tmpStr & i & ActiveCell.Offset(0, 111) & ", "
                        Case Is <= ActiveCell.Offset(0, 98)
                            tmpStr = tmpStr & i & ActiveCell.Offset(0, 112) & ", "
                        Case Is <= ActiveCell.Offset(0, 100)
                            tmpStr = tmpStr & i & ActiveCell.Offset(0, 113) & ", "
                        Case Else
                            tmpStr = tmpStr & i & ActiveCell.Offset(0, 114) & ", "
                        End Select
                    Next
                    tmpStr = Left$(tmpStr, Len(tmpStr) - 2)
                    MyDic.Add LCase$(RegM), 1
                End If
            Next
        End If
        .Pattern = "\d+[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

RegEx3.xls
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
  • 2
  • 2
5 Comments
 
LVL 50

Expert Comment

by:Dave Brett
ID: 33687572
John,

You can add a second cell ref to replace activecell. Plus then update the OFFSET logic, see below

So AD11 then becomes
=IF(T11=0,MID(AV11,BG11,4),IF(T11=T9,"",GetSeats(T11,T1)))

to anchor T1 as the OFFSET reference

I didn't understand your "," point. Can you psl expand

Cheers

Dave

Function GetSeats(InputCell As Range) As String   ' 'brettdj
    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(S)? (\d+)-(\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(2)
                        Select Case i
                        Case Is <= ActiveCell.Offset(0, 96)
                            tmpStr = tmpStr & i & ActiveCell.Offset(0, 111) & ", "
                        Case Is <= ActiveCell.Offset(0, 98)
                            tmpStr = tmpStr & i & ActiveCell.Offset(0, 112) & ", "
                        Case Is <= ActiveCell.Offset(0, 100)
                            tmpStr = tmpStr & i & ActiveCell.Offset(0, 113) & ", "
                        Case Else
                            tmpStr = tmpStr & i & ActiveCell.Offset(0, 114) & ", "
                        End Select
                    Next
                    tmpStr = Left$(tmpStr, Len(tmpStr) - 2)
                    MyDic.Add LCase$(RegM), 1
                End If
            Next
        End If
        .Pattern = "\d+[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

RegEx3a.xls
0
 
LVL 1

Author Comment

by:gabrielPennyback
ID: 33688271
Hi Dave, I'll check this out when I get back to work tomorrow. I just opened the workbook that I attached and it's not working the way it was on my computer., so here's a revised version. It explains the caomma thing.
Thanks,
John

RegEx4.xls
0
 
LVL 50

Accepted Solution

by:
Dave Brett earned 500 total points
ID: 33688334
John,

Thats useful

Now sorted.

The reason you had to D2 for each formula is that the old code used the formula cell as a reference point - so if that cell was not active then the UDF dies

The new version can be used like
=GetSeats(T11,DV11)
which sayes look at T11 for the row string, then compare the sub rows versus the J-Y2 Class info in DU to EV, to assign the sets in EK to EN

Cheers

Dave

Sub CalcAffectedSeats()
'Application.Calculation = xlCalculationManual
'On Error GoTo alert
[G4].Calculate
If [G4] > 0 Then
[AllSerNos].AutoFilter Field:=1, Criteria1:="#N/A"
'Call Alert1
Exit Sub
Else
End If
[AllSeats].ClearContents
[AllSeatsAffected].Calculate
Application.Calculation = xlCalculationManual
    Call GetAffectedSeats(Range("AD6:AD" & Range("AD" & Rows.Count).End(xlUp).Row), 200)
    [SumSeats].Calculate
    [G1].Calculate
'alert:
'MsgBox "Most likely there's an incident here involving a tail that's not in the Flight Hours table. Check for errors in AllConfigs.xls", vbOKOnly
End Sub
Sub GetAffectedSeats(rng As Range, Optional cutoffRow As Long) 'WarCrimes
    Dim seatArray As Variant, seat As Variant
    Dim cel As Range
    Dim k As Long, i As Long, seatNum As Variant, numSeats As Long
    Application.ScreenUpdating = False
    'Late binding
    Dim RegEx As Object, RegMatchCollection As Object   'Dimension the RegExp objects
    Set RegEx = CreateObject("vbscript.regexp") 'create the RegExp Object with late binding
   
    With RegEx  'set the RegExp parameters
        .Global = False  'look for first match only
        .Pattern = "\d+" 'look for numeric strings of any length (only returns first match because Global = FALSE)
    End With

    For Each cel In rng
        seatArray = Split(cel, ",")
                
        Range("AE" & cel.Row & ":AI" & cel.Row) = 0  'Reset the affected seat counts
        'OPTIONAL:   'If IsMissing(cutoffRow) Or (Not IsMissing(cutoffRow) And cel.Row <= cutoffRow) _
        'OPTIONAL:   '  Or (Not IsMissing(cutoffRow) And cel.Row > cutoffRow And Range("T" & cel.Row) <> Range("T" & cel.Row - 1)) Then
            For Each seat In seatArray
                Set RegMatchCollection = RegEx.Execute(seat)
                seatNum = RegMatchCollection.Item(0)
                numSeats = Len(Trim(seat)) - Len(seatNum)
        
                Select Case CLng(seatNum)
                    Case ActiveSheet.Cells(cel.Row, [J_Lo].Column) To ActiveSheet.Cells(cel.Row, [J_Hi].Column)     'J-Class
                        Range("AF" & cel.Row) = Range("AF" & cel.Row) + numSeats
                    Case ActiveSheet.Cells(cel.Row, [B_Lo].Column) To ActiveSheet.Cells(cel.Row, [B_Hi].Column)     'B-Class
                        Range("AG" & cel.Row) = Range("AG" & cel.Row) + numSeats
                    Case ActiveSheet.Cells(cel.Row, [Y_Lo].Column) To ActiveSheet.Cells(cel.Row, [Y_Hi].Column)     'Y-Class
                        Range("AH" & cel.Row) = Range("AH" & cel.Row) + numSeats
                    Case ActiveSheet.Cells(cel.Row, [Y2_Lo].Column) To ActiveSheet.Cells(cel.Row, [Y2_Hi].Column)   'Y2-Class
                        Range("Ai" & cel.Row) = Range("Ai" & cel.Row) + numSeats
                End Select
            Next seat
            Range("AE" & cel.Row) = Evaluate("=SUM(AF" & cel.Row & ":AI" & cel.Row & ")")
        'OPTIONAL:   ' End If
    Next cel
    Application.ScreenUpdating = True
End Sub
Function GetSeats(InputCell As Range, RefCell As Range) As String   ' 'brettdj
    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(S)? (\d+)-(\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(2)
                   ' If Len(tmpStr) > 0 Then tmpStr = tmpStr & ", "
                        Select Case i
                        Case Is <= RefCell
                            tmpStr = tmpStr & i & RefCell.Offset(0, 15) & ", "
                        Case Is <= ActiveCell.Offset(0, 98)
                            tmpStr = tmpStr & i & RefCell.Offset(0, 16) & ", "
                        Case Is <= ActiveCell.Offset(0, 100)
                            tmpStr = tmpStr & i & RefCell.Offset(0, 17) & ", "
                        Case Else
                            tmpStr = tmpStr & i & RefCell.Offset(0, 18) & ", "
                        End Select
                    Next
                   
                    MyDic.Add LCase$(RegM), 1
                End If
            Next
             tmpStr = Left$(tmpStr, Len(tmpStr) - 2)
        End If
        .Pattern = "\d+[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

RegEx4.xls
0
 
LVL 1

Author Comment

by:gabrielPennyback
ID: 33697829
Great, Dave, thanks. I understand this well enough that I modified the cases so that they are all based on the RefCell.
I would like to understand it better of course. Can you point out some specific values in my actual workbook that will help me understand what's going on in this line?
For i = RegM.submatches(1) To RegM.submatches(2)  
What part of T6 is captured in RegM.submatches(1)?
What part of T6 is captured in RegM.submatches(2)?
Same for T8.
What exactly is the function doing with cells T6 and T8 to produce the results it produces?
Thanks,
John

For i = RegM.submatches(1) To RegM.submatches(2)
                        Select Case i
                        Case Is <= RefCell
                            tmpStr = tmpStr & i & RefCell.Offset(0, 15) & ", "
                        Case Is <= RefCell.Offset(0, 2)
                            tmpStr = tmpStr & i & RefCell.Offset(0, 16) & ", "
                        Case Is <= RefCell.Offset(0, 4)
                            tmpStr = tmpStr & i & RefCell.Offset(0, 17) & ", "
                        Case Else
                            tmpStr = tmpStr & i & RefCell.Offset(0, 18) & ", "
                        End Select
                    Next

Open in new window

0

Featured Post

Scamming the Scammers!

Have you ever heard of Scam Baiting?
It's a highly entertaining sport that you can participate in.
Introduction to beating scammers at their own game and how you can help
Share your thoughts, ideas and experiences on the topic.
Links to top Anti-Scam resources provided.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
drag and drop (but keep all) lines 11 48
LOOK FOR 22 34
WIthin VBA summing record count in 3 tabs 7 42
MS Office unistall Utility 2 27
You need to know the location of the Office templates folder, so that when you create new templates, they are saved to that location, and thus are available for selection when creating new documents.  The steps to find the Templates folder path are …
This article describes a serious pitfall that can happen when deleting shapes using VBA.
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.
Finds all prime numbers in a range requested and places them in a public primes() array. I've demostrated a template size of 30 (2 * 3 * 5) but larger templates can be built such 210  (2 * 3 * 5 * 7) or 2310  (2 * 3 * 5 * 7 * 11). The larger templa…

752 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