<

Range Iteration

Published on
11,985 Points
2,285 Views
2 Endorsements
Last Modified:
Awarded

Introduction

I recently answered a question where the solution involved creating files with numeric names in particular ranges (in this case, 1 to 23 and 30).  This article shows how to implement a range iterator for your VBA/VBScript/VB projects.


Our Goal

When you finish reading the article, I want you to understand the different solution paths and be able to implement them in your projects.  The desired code is

  • simple
  • efficient
  • easy to understand
  • easy to maintain
 

The Brute Force approach

For expediency, I used a brute force solution in answering the question.  In the following example, assume that the Debug.Print line represents the actual task that needs to be accomplished for that numeric value.

Sub LoopingRanges_BruteForce()
    Dim lngLoop As Long
    For lngLoop = 1 To 23
        Debug.Print lngLoop, ;
    Next
    For lngLoop = 30 To 30
        Debug.Print lngLoop, ;
    Next
    Debug.Print
End Sub

Open in new window


Expected Output

For the non-parameterized code examples, their output will be the following sequence in the Immediate window.

1  2  3  4  5  6  7  8  9  10  11  12  13  14  15  16  17  18  19  20  21  22  23  30           

Open in new window


The Arrays Function

There is a very handy function with which you can create one-dimensional (vectors) and multi-dimension arrays (2D, 3D, ...60D).  We can use the Array() function to create a vector (1D array) of two item lists (also vectors).  Each of the two item lists will be the lower and upper bounds for our loop.  Our BruteForce example now transforms into this streamlined routine.

Sub LoopingRanges_Arrays()
    Dim vItem As Variant
    Dim lngLoop As Long
    For Each vItem In Array(Array(1, 23), Array(30, 30))
        For lngLoop = vItem(0) To vItem(1)
            Debug.Print lngLoop, ;
        Next
    Next
    Debug.Print
End Sub

Open in new window

We have effectively refactored the code, eliminating the duplicate For...Next loops in our BruteForce example.


A Data-Driven Solution

However, the ranges are still hard coded.  What we would like to do is create a data-driven solution, where the ranges are not actually coded, but exist in some parsable form.  I am fond of the Pascal set specification, so I went with that format for my range specification.  It is less complicated than some other options, such as YAML, JSON, and XML.  Here is a description of Pascal sets:
http://www.delphibasics.co.uk/Article.asp?Name=Sets
For simplicity, these next two code examples use a string contstant ("1..23,30").  We will parameterize these range values by the end of the article.  Promise.


Parsing With Split

The most efficient parse will use the Split() function.  We first split on the comma delimiter and each of those values is then split on the "..", if it exists.  For single value ranges, we use the lower range value as the upper range value.

Sub LoopingRanges_Split()
    Dim vItem As Variant
    Dim lngLoop As Long
    Dim strRanges() As String
    Dim strLowerUpper() As String
    Dim lngLow As Long, lngHigh As Long
    Const cRange As String = "1..23,30"
    
    strRanges = Split(cRange, ",")
    For Each vItem In strRanges
        strLowerUpper = Split(CStr(vItem), "..")
        'parse each range for the lower and upper values
        lngLow = CLng(strLowerUpper(0))
        If UBound(strLowerUpper) = 0 Then
            'for single value ranges, the upper = lower
            lngHigh = lngLow
        Else
            lngHigh = CLng(strLowerUpper(1))
        End If
        
        For lngLoop = lngLow To lngHigh
            Debug.Print lngLoop, ;
        Next
    Next
    Debug.Print
End Sub

Open in new window


Parse With Regex

I'm a fan of regular expresions.  It is a very powerful method of parsing strings.  Even though it is not as efficient as the Split() function, I wanted you to see what such a solution would look like.

Sub LoopingRanges_Regex()
    Dim lngLoop As Long
    Dim lngLow As Long, lngHigh As Long
    Const cRange As String = "1..23,30"
    Dim oRE As Object, oMatches As Object, oM As Object
    Set oRE = CreateObject("vbscript.regexp")
    oRE.Global = True
    oRE.Pattern = "(\d+)(?:\.\.){0,1}(\d+){0,1}(?:,|$)"
    
    If oRE.test(cRange) Then
        Set oMatches = oRE.Execute(cRange)
        For Each oM In oMatches
            lngLow = CLng(oM.submatches(0))
            If IsEmpty(oM.submatches(1)) Then
                'for single value ranges, the upper = lower
                lngHigh = Val(oM.submatches(0))
            Else
                lngHigh = Val(oM.submatches(1))
            End If
            For lngLoop = lngLow To lngHigh
                Debug.Print lngLoop, ;
            Next
        Next
    Else
        MsgBox "invalid ranges string"
    End If
    Debug.Print
End Sub

Open in new window

For more information about regular expressions, read Patrick Matthews's introduction to the topic:
http:A_1336-Using-Regular-Expressions-in-Visual-Basic-for-Applications-and-Visual-Basic-6.html


Notes


  • The amount of code in our routines has increased because of the parsing.
  • I added some validation into the Regex example.  Validating your input is always a good idea.


We Need a Function

We need to package the parsing code and return some iterable collection/array/list/dictionary value (object).


Let's Use a Collection of Array objects

The VBA environment gives us two very-easy-to-use objects, the collection object an the Array() function result which we have already seen above.  Without any of the parsing code, the following example populates a collection with hard-coded Array() results.

Function ReturnRanges_StaticArrays() As Collection
    Dim colReturn As New Collection
    
    colReturn.Add Array(1, 23)
    colReturn.Add Array(30, 30)
    
    Set ReturnRanges_StaticArrays = colReturn
End Function

Open in new window

I like to test my code as I develop, so here is a routine that uses

Sub Test_ReturnRanges_StaticArrays()
    Dim vItem As Variant
    For Each vItem In ReturnRanges_StaticArrays
        For lngLoop = vItem(0) To vItem(1)
            Debug.Print lngLoop, ;
        Next
    Next
    Debug.Print
End Sub

Open in new window


We Have Arrived

Now that we know the individual parts work as desired, let's put it all together.

Function ReturnRanges_Arrays(parmRanges As String) As Collection
    Dim colReturn As New Collection
    Dim vItem As Variant
    Dim lngLoop As Long
    Dim strRanges() As String
    Dim strLowerUpper() As String
    Dim lngLow As Long, lngHigh As Long
    
    strRanges = Split(parmRanges, ",")
    For Each vItem In strRanges
        strLowerUpper = Split(CStr(vItem), "..")
        
        'parse each range for the lower and upper values
        lngLow = CLng(Val(strLowerUpper(0)))
        If UBound(strLowerUpper) = 0 Then
            'for single value ranges, the upper = lower
            lngHigh = lngLow
        Else
            lngHigh = CLng(Val(strLowerUpper(1)))
        End If
        
        colReturn.Add Array(lngLow, lngHigh)
        
    Next
        
    Set ReturnRanges_Arrays = colReturn
End Function

Open in new window


Here is an example of how you would use our new function:
Sub testRR()
    Dim lngLoop As Long
    Dim vItem As Variant
    For Each vItem In ReturnRanges_Arrays("1..5,11,28..30,15..19")
        For lngLoop = vItem(0) To vItem(1)
            Debug.Print lngLoop, ;
        Next
    Next
    Debug.Print
End Sub

Open in new window


A VBScript Version

Since there is no Collection object in the VBScript environment, you would use a dictionary object.

Function ReturnRanges_Arrays_VBS(parmRanges)
'VBScript version of ReturnRanges_Arrays
    Dim colReturn
    Dim vItem
    Dim lngLoop
    Dim strRanges
    Dim strLowerUpper
    Dim lngLow, lngHigh
    
    Set colReturn = CreateObject("scripting.dictionary")
    lngLoop = 0
    strRanges = Split(CStr(parmRanges), ",")
    For Each vItem In strRanges
        strLowerUpper = Split(CStr(vItem), "..")
        
        'parse each range for the lower and upper values
        lngLow = CLng(Val(strLowerUpper(0)))
        If UBound(strLowerUpper) = 0 Then
            'for single value ranges, the upper = lower
            lngHigh = lngLow
        Else
            lngHigh = CLng(Val(strLowerUpper(1)))
        End If
        
        lngLoop = lngLoop + 1
        colReturn.Add CStr(lngLoop), Array(lngLow, lngHigh)
        
    Next
        
    Set ReturnRanges_Arrays_VBS = colReturn
End Function

Open in new window

And our VBScript test code looks like this:

Sub testRR_VBS()
    Dim lngLoop
    Dim vItem
    Dim vRanges
    Set vRanges = ReturnRanges_Arrays_VBS("1..5,11,28..30")
    For Each vItem In vRanges
        For lngLoop = vRanges(vItem)(0) To vRanges(vItem)(1)
            Debug.Print lngLoop, ;
        Next
    Next
    Debug.Print
End Sub

Open in new window


Conclusion

We started with a brute-force implementation of iteration through different ranges and arrived at an elegant implementation of Pascal set representation.  You can iterate the returned low-high ranges and your code will be very maintainable.  You could specify your ranges externally (file, database, registry, user input) or have a very small string constant/literal that is easy to understand.

If you needed to, you could implement this range-iteration functionality for one of your own classes, subroutines, or functions.  This article's code can be used in many different places.  Please post a comment and let me know how and where you've used it.


The Code

For your convenience, here is a .bas file with the VBA code: RangeIteration.bas


Further Reading

This article is related to one of my earliest articles, which was also on VB iteration statements.
http:A_2755-Next-Iteration-functionality-in-VB-classic-and-VBA.html
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
If you liked this article and want to see more from this author,  please click here.
 
If you found this article helpful, please click the Yes button near the:
 
      Was this article helpful?
 
label that is just below and to the right of this text.   Thanks!
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
2
Comment
Author:aikimark
  • 3
  • 2
5 Comments
 
LVL 59

Expert Comment

by:Joe Winograd, Fellow&MVE
This is an awesome piece of work! Congratulations to the author! Regards, Joe
0
 
LVL 47

Author Comment

by:aikimark
Glad you liked it, Joe.  Check out my other EE artcles.

And consider writing some articles of your own.
0
 
LVL 59

Expert Comment

by:Joe Winograd, Fellow&MVE
I'll definitely check out your other articles.

I've published 23 articles and 10 videos here at EE, and am always considering some new ones. But as you know, it takes a while to write a good article — need to find the time! :)
0
 
LVL 47

Author Comment

by:aikimark
In case you need to support decreasing ranges as well as increasing ranges:
Sub testRR()
    Dim lngLoop As Long
    Dim vItem As Variant
    Dim lngStep As Long
    
    For Each vItem In ReturnRanges_Arrays("5..1,11,28..30,19..15")
        
        lngStep = Sgn(vItem(1) - vItem(0))
        If lngStep = 0 Then lngStep = 1
        
        For lngLoop = vItem(0) To vItem(1) Step lngStep
            Debug.Print lngLoop, ;
        Next
    Next
    Debug.Print
End Sub

Open in new window

0
 
LVL 59

Expert Comment

by:Joe Winograd, Fellow&MVE
Nice addition!
0

Featured Post

Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

Join & Write a Comment

As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…
Next Article:

Keep in touch with Experts Exchange

Tech news and trends delivered to your inbox every month