Creating Range values from a Array VBA

Question

I am newbie to VBA. Can someone please assist me here

I have two Arrays

Pages=(1,2,3,4,5,6,7,8,9,10)
Exclusion=(1,1,3,3,7)

I want to write a piece of code that compares the arrays and gives me a single output like

(1,2,3,4-6,7,8-10)

On iterating Pages array if a value is available on the Exclusion array, i want to retain the single element on my resultant array else values should be grouped

Answer 1

This wants a little precision and I hope I got it right. Here is the function I constructed. It doesn't place the 4 in a separate group because it isn't listed in the Exclusions but it certainly needs more testing than I have done. Be my guest lol:

Function Pagelist(Pages As Variant, _
                  Exclusions As Variant) As String
    ' 015

    Dim Fun() As String
    Dim n As Long
    Dim Excl As String
    Dim Sp() As String
    Dim i As Long

    ReDim Fun(LBound(Pages) + UBound(Pages))
    Excl = "," & Join(Exclusions, ",") & ","

    For i = LBound(Pages) To UBound(Pages)
        If InStr(Excl, "," & Pages(i) & ",") Then
            If Len(Fun(n)) Then n = n + 1
            Fun(n) = Pages(i)
            n = n + 1
        Else
            If Len(Fun(n)) Then
                Sp = Split(Fun(n), "-")
                If UBound(Sp) = 0 Then ReDim Preserve Sp(1)
                Sp(1) = Pages(i)
                Fun(n) = Join(Sp, "-")
            Else
                Fun(n) = Pages(i)
            End If
        End If
    Next i

    If n Then ReDim Preserve Fun(n)
    Pagelist = Join(Fun, ",")
End Function

For testing purposes you can call the function with a procedure like the one below.

Private Sub Test()

    Dim Pages As Variant
    Dim Exclusions As Variant

    Pages = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10)
    Exclusions = Array(1, 1, 3, 3, 7)
    Debug.Print Pagelist(Pages, Exclusions)
End Sub

Answer 2

Get Pages Exclusion

Option Explicit

Function getPagesExclusion(Pages As Variant, Exclusion As Variant, _
  Optional Delimiter As String = "-") As Variant

    Dim Resultant As Variant
    Dim CurrentValue As Long
    Dim StartValue As Long
    Dim EndValue As Long
    Dim i As Long
    Dim k As Long
    Dim Result As String

    For i = 0 To UBound(Pages)
        CurrentValue = Pages(i)
        If Not IsError(Application.Match(CurrentValue, Exclusion, 0)) Then
            GoSub Found
            GoSub FoundCurrent
        Else
            GoSub NotFound
        End If
    Next i
    GoSub Found

    getPagesExclusion = Resultant

GoTo exitProcedure

Found:
    If StartValue <> 0 Then
        If EndValue > StartValue Then
            Result = StartValue & Delimiter & EndValue
        Else
            Result = EndValue
        End If
        GoSub writeToResultant
    End If
Return

FoundCurrent:
    Result = CurrentValue
    GoSub writeToResultant
    StartValue = 0
    EndValue = 0
Return

NotFound:
    If StartValue = 0 Then StartValue = CurrentValue
    EndValue = CurrentValue
Return

writeToResultant:
    If k > 0 Then ReDim Preserve Resultant(k) Else ReDim Resultant(0) As String
    Resultant(k) = Result: k = k + 1
Return

exitProcedure:

End Function

Sub getPagesExclusionExample()

    Dim Pages As Variant
    Dim Exclusion As Variant
    Dim Resultant As Variant

    Pages = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10)
    Exclusion = Array(1, 1, 3, 3, 7)

    Resultant = getPagesExclusion(Pages, Exclusion)

    Debug.Print Join(Resultant, ", ")

    'or:

    Dim i As Long
    Resultant = getPagesExclusion(Pages, Exclusion, " To ")
    For i = 0 To UBound(Resultant): Debug.Print Resultant(i): Next i

End Sub

Answer 3

I avoided to use another function in order to write OutRange (it would be better and cleaner code, but that wasn't the topic)

Option Explicit

'Pages need to be in ASCendent order
Function GetPageRanges(Pages() As Variant, Exclusion() As Variant) As String

    GetPageRanges = ""

    'Dim Pages(), Exclusion As Variant
    Dim OutRange(0 To 1) As Variant
    Dim Page As Variant
    Dim SExcl As String

   ' Pages = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10)
    'Exclusion = Array(1, 1, 3, 3, 7)
    SExcl = "," & Join(Exclusion, ",") & "," 'Every page is sorrounded by commas

    OutRange(0) = Null
    OutRange(1) = Null

    For Each Page In Pages
        'Comma-sorrounding is used in order to delimit page number
        '(searching for "2" in a string will match even when it contains page "123").
        'Searching for ",2," will not match with ",123,"

        If InStr(SExcl, "," & Page & ",") Then
            'Page is in Exclusion list
            'Previous range, if existing, has to be written as range excluding this page.
            'If previus range has only a left/lower bound than it has to be written as a single page.
            'After that also this page has to be written as a single page

            If Not IsNull(OutRange(0)) Then
                'There was a range or a single page
                GetPageRanges = GetPageRanges & OutRange(0)
                If Not IsNull(OutRange(1)) Then GetPageRanges = GetPageRanges & "-" & OutRange(1)
                GetPageRanges = GetPageRanges & ","

                'Clean OutRange
                OutRange(0) = Null
                OutRange(1) = Null
            End If

            'Add this page (found in exclusion)
            GetPageRanges = GetPageRanges & Page & ","

        Else
            'Page is NOT in Exclusion list

            'If OutRange is not started I put page as left/lower bound
            If (IsNull(OutRange(0))) Then
                OutRange(0) = Page
            Else
                'If the range is the one following the left/lower bound then it's inside the same range
                'If this page is the one following the previous right/upeer bound then it's inside the same range.
                'If some page has been skipped the range has to be closed , written and a new open it's opened
                If ((OutRange(0) + 1) = Page) Then
                    OutRange(1) = Page
                ElseIf (CInt(OutRange(1) + 1) = Page) Then
                    'Same action of the if statement expression. We need to use else if in order to use
                    'CInt(OutRange(1)) only if we know that it's not null
                    OutRange(1) = Page
                Else
                    'Like when an excluded page is found, we write down out range and clean it
                    GetPageRanges = GetPageRanges & OutRange(0)
                    If Not IsNull(OutRange(1)) Then GetPageRanges = GetPageRanges & "-" & OutRange(1)
                    GetPageRanges = GetPageRanges & ","
                    OutRange(0) = Null
                    OutRange(1) = Null

                    'This page is written for next range left/lower bound
                    OutRange(0) = Page
                End If

            End If

        End If
    Next Page

    'If the last page was not in exclusion than we have to write down OutRange
    GetPageRanges = GetPageRanges & OutRange(0)
    If Not IsNull(OutRange(1)) Then GetPageRanges = GetPageRanges & "-" & OutRange(1)
    GetPageRanges = GetPageRanges & ","

    'Remove last character (is a comma)
    If GetPageRanges <> "" Then GetPageRanges = Left(GetPageRanges, Len(GetPageRanges) - 1)
End Function

Sub Run()
    Dim Pages() As Variant
    Dim Exclusion() As Variant

    Pages = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10)
    Exclusion = Array(1, 1, 3, 3, 7)

    Debug.Print GetPageRanges(Pages, Exclusion)

End Sub