CODEWITHSUNDEEP
excelvba
user14593616
user14593616

Reputation:

Remove item from Array at Specific Index

I have an array of numbers, once i "use" a number I want to remove using a specific index I have stored for that value.

I know there is no direct method but is there a way I work around this?

Example:

ShiftArray(1,25,12)

Pos = 1

Shiftarray(pos).delete

The array then should be = ShiftArray(1,12)

(I know such a method does not exist, just for clarity of intention's sake)

I tried the following but it gave me an error:

ShiftHeadsArray(pos - 1) = " "
StringUse = Application.WorksheetFunction.Trim(Join(ShiftHeadsArray, " "))
ShiftHeadsArray = Split(StringUse, " ")

Where pos is the position of the number I want to remove within the array.

Upvotes: 1

Views: 421

Answers (3)

VBasic2008
VBasic2008

Reputation: 54807

Remove Array Item by Index

Option Explicit

Sub TESTremoveArrayItemByIndex()
    Dim Addresses As Variant: Addresses = Array("A1", "A2", "A3")
    Dim Values As Variant: Values = Array(1, 25, 10)
    Dim mIndex As Variant
    mIndex = Application.Match(Application.Max(Values), Values, 0)
    Dim dAddress As String: dAddress = Application.Index(Addresses, mIndex)
    ' If you are sure that 'Addresses' is zero-based, instead of the previous
    ' line you can do:
    'Dim cAddress As String: cAddress = Addresses(Index - 1)
    removeArrayItemByIndex Addresses, mIndex
    Debug.Print "Addresses(After):  " & Join(Addresses, ",")
    removeArrayItemByIndex Values, mIndex
    Debug.Print "Values(After):     " & Join(Values, ",")
End Sub

Sub TESTremoveArrayItemByIndexDebugPrint()
    Dim Addresses As Variant: Addresses = Array("A1", "A2", "A3")
    Debug.Print "Addresses(Before): " & Join(Addresses, ",")
    Dim Values As Variant: Values = Array(1, 25, 10)
    Debug.Print "Values(Before):    " & Join(Values, ",")
    Dim mIndex As Variant
    mIndex = Application.Match(Application.Max(Values), Values, 0)
    Debug.Print "Maximum Index:     " & mIndex
    Dim dAddress As String: dAddress = Application.Index(Addresses, mIndex)
    ' If you are sure that 'Addresses' is zero-based, instead of the previous
    ' line you can do:
    'Dim cAddress As String: cAddress = Addresses(Index - 1)
    Debug.Print "Delete Address:    " & dAddress
    removeArrayItemByIndex Addresses, mIndex
    Debug.Print "Addresses(After):  " & Join(Addresses, ",")
    removeArrayItemByIndex Values, mIndex
    Debug.Print "Values(After):     " & Join(Values, ",")
End Sub

Sub removeArrayItemByIndex( _
        ByRef arr As Variant, _
        ByVal Index As Long)
    Dim n As Long
    For n = Index + LBound(arr) - 1 To UBound(arr) - 1
        arr(n) = arr(n + 1)
    Next n
    ReDim Preserve arr(LBound(arr) To n - 1)
End Sub

Upvotes: 0

AHeyne
AHeyne

Reputation: 3455

Having a array-only based solution isn't so trivial, if you're interested in catching possible errors.

Remark: Instead of just returning an empty array or the input array like in this example, you should raise an error if the input isn't proper. But this depends on how you like the function to behave.

Public Sub Test()
    'Some common tests:
    Debug.Assert Join(RemoveItemByIndex(Array(), 1), "-") = vbNullString
    Debug.Assert Join(RemoveItemByIndex(Array(1), 0), "-") = vbNullString
    Debug.Assert Join(RemoveItemByIndex(Array(1), 1), "-") = vbNullString
    Debug.Assert Join(RemoveItemByIndex(Array(1, 25, 12), 1), "-") = "1-12"
    Debug.Assert Join(RemoveItemByIndex(Array(1, 25, 12), 10), "-") = "1-25-12"
    Debug.Assert Join(RemoveItemByIndex(Array(1, 25, 12), -1), "-") = "1-25-12"

    Debug.Assert Join(RemoveItemByIndex("foo", -1), "-") = vbNullString

    'Your working sample:
    Dim originalArray() As Variant
    originalArray = Array(1, 25, 12)

    Dim item As Variant
    For Each item In RemoveItemByIndex(originalArray, 1)
        Debug.Print item
    Next item
End Sub

Public Function RemoveItemByIndex(ByVal arrayToWorkOn As Variant, ByVal indexToRemove As Long) As Variant()
    RemoveItemByIndex = Array()

    If Not IsArray(arrayToWorkOn) Then Exit Function
    If Not IsArrayInitialized(arrayToWorkOn) Then Exit Function
    If UBound(arrayToWorkOn) - LBound(arrayToWorkOn) = 0 Then Exit Function

    RemoveItemByIndex = arrayToWorkOn

    If indexToRemove < LBound(arrayToWorkOn) _
        Or indexToRemove > UBound(arrayToWorkOn) Then Exit Function

    ReDim resultingArray(UBound(arrayToWorkOn) - 1) As Variant

    Dim index As Long
    Dim resultingIndex As Long
    For index = LBound(arrayToWorkOn) To UBound(arrayToWorkOn): Do
        If index = indexToRemove Then Exit Do

        resultingArray(resultingIndex) = arrayToWorkOn(index)
        resultingIndex = resultingIndex + 1
    Loop While False: Next index

    RemoveItemByIndex = resultingArray
End Function

Public Function IsArrayInitialized(ByVal arrayToWorkOn As Variant) As Boolean
    On Error Resume Next
    IsArrayInitialized = IsArray(arrayToWorkOn) And _
                    Not IsError(LBound(arrayToWorkOn, 1)) And _
                    LBound(arrayToWorkOn, 1) <= UBound(arrayToWorkOn, 1)
End Function

Regarding the : Do and Loop While False:: This is a neat trick to simulate a 'continue'. See here for more information: VBA - how to conditionally skip a for loop iteration

Upvotes: 0

YasserKhalil
YasserKhalil

Reputation: 9538

Try this code

Sub Test()
    Dim arr
    arr = Array(1, 25, 12)
    DeleteItem arr, 1
    Debug.Print Join(arr, ", ")
End Sub

Sub DeleteItem(ByRef arr, v)
    Dim a(), i As Long, n As Long, x As Long, y As Long
    x = LBound(arr): y = UBound(arr)
    ReDim a(x To y)
    For i = x To y
        If i <> v Then a(i - n) = arr(i) Else n = n + 1
    Next i
    If (y - n) >= x Then ReDim Preserve a(x To y - n)
    arr = a
End Sub

Upvotes: 1

Related Questions