Check if array is consecutive then delete values in between vba

Question

I currently have an array that is being set by selected items from a listbox. I need to know how to check to see if there are consecutive values in the array then delete the values that are between the lowest and highest values of the consecutive numbers.

Here is an example to show what I mean:

Dim sheets() As Long
Dim Selected As String

ReDim sheets(i)
For i = 1 To ListBox1.ListCount - 1
    If ListBox1.Selected(i) = True Then
        Selected = ListBox1.List(i)
        ReDim Preserve sheets(i)
        sheets(i) = Selected
    End If
Next i

The array is used for a Solidworks API function that sets the print sheet range. This is why I cant have more than 2 consecutive numbers.

That being said if there is an easier way to do this based on deselecting the consecutive listbox items I am all ears for that too.

Thank you

Answer 1

With these values in the listbox (all selected), you get:

ListBox  Result -> Array(1, 3, 5, 7, 9, 11)
   1        1
   3        3
   4  
   5        5
   7        7
   8  
   9        9
  11       11

---

Option Explicit

Public Sub GetMinMaxOfConsecutives()
    Dim sheets() As Long, i As Long, totalItms As Long
    Dim prev As Boolean, nxt As Boolean, used As Long, this As Long

    used = 1
    With ListBox1    'Sheet1.ListBox1
        totalItms = .ListCount - 1
        ReDim sheets(1 To totalItms)
        For i = 1 To totalItms - 1
            If .Selected(i) Then
                this = .List(i)
                prev = IIf(.Selected(i - 1), this - 1 <> .List(i - 1), True)
                nxt = IIf(.Selected(i + 1), this + 1 <> .List(i + 1), True)
                If prev Or nxt Then
                    sheets(used) = this
                    used = used + 1
                End If
            End If
        Next
        If .Selected(i) Then sheets(used) = .List(i) Else used = used - 1
        If used > 0 Then ReDim Preserve sheets(1 To used) Else ReDim sheets(0)
        'ShowArray sheets
    End With
End Sub

---

Private Sub ShowArray(ByRef arr() As Long)
    Dim i As Long
    For i = LBound(arr) To UBound(arr)
        Debug.Print arr(i)
    Next
End Sub

---

Edit:

To double the items not part of a sequence make sure to increase the initial array size to accommodate for this case:

ListBox  Result -> Array(1, 1, 3, 3, 5, 5, 7, 7, 9, 9)
   1
   3
   5
   7
   9

---

Public Sub GetMinMaxOfConsecutives2()
    Dim sheets() As Long, i As Long, totalItms As Long
    Dim prev As Boolean, nxt As Boolean, used As Long, this As Long

    used = 1
    With ListBox1
        totalItms = .ListCount - 1

        ReDim sheets(1 To totalItms * 2 + 1)    '<-- double upper bound

        For i = 1 To totalItms - 1
            If .Selected(i) Then
                this = .List(i)

                prev = IIf(.Selected(i - 1), this - 1 <> .List(i - 1), True)
                nxt = IIf(.Selected(i + 1), this + 1 <> .List(i + 1), True)

                If prev Or nxt Then
                    If prev And nxt Then
                        sheets(used) = this
                        used = used + 1
                    End If
                    sheets(used) = this
                    used = used + 1
                End If

            End If
        Next

        If .Selected(i) Then sheets(used) = .List(i) Else used = used - 1
        If used > 0 Then ReDim Preserve sheets(1 To used) Else ReDim sheets(0)
        'ShowArray sheets

    End With
End Sub

---

Note:

If you use the ListFillRange property to fill in the items in the listbox make sure you don't use entire columns, for example don't use "A:A" because this will add 1+ M items to the list (even empty cells)

If Microsoft decides to increase the grid size to a billion rows in a new Excel version, working with the listbox will take a long time

Instead always populate it with the used range from the respective column:

ListBox1.ListFillRange = Sheet1.UsedRange.Columns(1).Address