19

I have a global array, prLst() that be can of variable length. It takes in numbers as strings "1" to Ubound(prLst). However, when the user enters "0", I want to delete that element from the list. I have the following code written to perform this:

count2 = 0
eachHdr = 1
totHead = UBound(prLst)

Do
    If prLst(eachHdr) = "0" Then
        prLst(eachHdr).Delete
        count2 = count2 + 1
    End If
    keepTrack = totHead - count2
    'MsgBox "prLst = " & prLst(eachHdr)
    eachHdr = eachHdr + 1
Loop Until eachHdr > keepTrack

This does not work. How do I efficiently delete elements in the array prLst if the element is "0"?

NOTE: This is part of a larger program, for which the description of can be found here: Sorting Groups of Rows Excel VBA Macro

Improve this question
1
  • It might not help in your use case, but if this was a worksheet function, you could use FILTER() to remove the zeros from an array. Commented Mar 30, 2023 at 3:50

8 Answers 8

Reset to default
41

An array is a structure with a certain size. You can use dynamic arrays in vba that you can shrink or grow using ReDim but you can't remove elements in the middle. It's not clear from your sample how your array functionally works or how you determine the index position (eachHdr) but you basically have 3 options

(A) Write a custom 'delete' function for your array like (untested)

Public Sub DeleteElementAt(Byval index As Integer, Byref prLst as Variant)
       Dim i As Integer
        
        ' Move all element back one position
        For i = index + 1 To UBound(prLst)
            prLst(i - 1) = prLst(i)
        Next
        
        ' Shrink the array by one, removing the last one
        ReDim Preserve prLst(LBound(prLst) To UBound(prLst) - 1)
End Sub

(B) Simply set a 'dummy' value as the value instead of actually deleting the element

If prLst(eachHdr) = "0" Then        
   prLst(eachHdr) = "n/a"
End If

(C) Stop using an array and change it into a VBA.Collection. A collection is a (unique)key/value pair structure where you can freely add or delete elements from

Dim prLst As New Collection
Improve this answer
Sign up to request clarification or add additional context in comments.

8 Comments

For collections, do the lengths of the collections ever have to be specified or "ReDimmed"? Also, can you loop through through collections element by element , arranging elements in a specific order? In addition, do you have to loop through to delete, or is there a way to say "all elements that are 'this', delete!" ?
No, the length of a collection does not have to be "redimmed" by you, the user. This makes collections much more convenient than arrays for tasks where items need to be added and removed. See documentation.
Lot of questions:) No redim needed. Yes you can loop through them and you insert element before or after other elements. Elements can be accessed by their index number (like the index in the array) or by the name of the key. Look further at msdn.microsoft.com/en-us/library/… and msdn.microsoft.com/en-us/library/a1y8b3b3(v=vs.80).aspx
After reading that this is still rather confusing. Originally, for my program I had been using arrays. Now I am using collection objects and simply want to delete all items in prLst with a "0", but I want to be able to know the index of which item i am deleting. So i can eventually delete an element of another collection headRow at the according index.
How is this a highly rated and accepted answer when Len(Array()) is a Type-Mismatch error? This code isn't usable as is. The shrink line should read ReDim Preserve thisArray(LBound(prLst) To UBound(prLst) -1)
|
2

here is a sample of code using the CopyMemory function to do the job.

It is supposedly "much faster" (depending of the size and type of the array...).

i am not the author, but i tested it :

Sub RemoveArrayElement_Str(ByRef AryVar() As String, ByVal RemoveWhich As Long) 

'// The size of the array elements
'// In the case of string arrays, they are
'// simply 32 bit pointers to BSTR's.
Dim byteLen As Byte

'// String pointers are 4 bytes
byteLen = 4

'// The copymemory operation is not necessary unless
'// we are working with an array element that is not
'// at the end of the array
If RemoveWhich < UBound(AryVar) Then
    '// Copy the block of string pointers starting at
    ' the position after the
    '// removed item back one spot.
    CopyMemory ByVal VarPtr(AryVar(RemoveWhich)), ByVal _
        VarPtr(AryVar(RemoveWhich + 1)), (byteLen) * _
        (UBound(AryVar) - RemoveWhich)
End If

'// If we are removing the last array element
'// just deinitialize the array
'// otherwise chop the array down by one.
If UBound(AryVar) = LBound(AryVar) Then
    Erase AryVar
Else
    ReDim Preserve AryVar(LBound(AryVar) To UBound(AryVar) - 1)
End If
End Sub
Improve this answer

Comments

1 
Sub DelEle(Ary, SameTypeTemp, Index As Integer) '<<<<<<<<< pass only not fixed sized array (i don't know how to declare same type temp array in proceder)
    Dim I As Integer, II As Integer
    II = -1
    If Index < LBound(Ary) And Index > UBound(Ary) Then MsgBox "Error.........."
    For I = 0 To UBound(Ary)
        If I <> Index Then
            II = II + 1
            ReDim Preserve SameTypeTemp(II)
            SameTypeTemp(II) = Ary(I)
        End If
    Next I
    ReDim Ary(UBound(SameTypeTemp))
    Ary = SameTypeTemp
    Erase SameTypeTemp
End Sub

Sub Test()
    Dim a() As Integer, b() As Integer
    ReDim a(3)
    Debug.Print "InputData:"
    For I = 0 To UBound(a)
        a(I) = I
        Debug.Print "    " & a(I)
    Next
    DelEle a, b, 1
    Debug.Print "Result:"
    For I = 0 To UBound(a)
        Debug.Print "    " & a(I)
    Next
End Sub
Improve this answer

1 Comment

Code-only answers are rarely good. It's best to add some text explaining it.
0

When creating the array, why not just skip over the 0s and save yourself the time of having to worry about them later? As mentioned above, arrays are not well-suited for deletion.

Improve this answer

1 Comment

This code is part of a larger code that I am creating found here: stackoverflow.com/questions/6671273/… This code is part of the sub EstSortPriorities. Because the program does not know which headers are the ones to sort at the top of the sheet, the user must specify. I have chosen that the user should enter a "0" if a sort priority was not wanted given a particular header.
0

I'm pretty new to vba & excel - only been doing this for about 3 months - I thought I'd share my array de-duplication method here as this post seems relevant to it:

This code if part of a bigger application that analyses pipe data- Pipes are listed in a sheet with number in xxxx.1, xxxx.2, yyyy.1, yyyy.2 .... format. so thats why all the string manipulation exists. basically it only collects the pipe number once only, and not the .2 or .1 part.

        With wbPreviousSummary.Sheets(1)
'   here, we will write the edited pipe numbers to a collection - then pass the collection to an array
        Dim PipeDict As New Dictionary

        Dim TempArray As Variant

        TempArray = .Range(.Cells(3, 2), .Cells(3, 2).End(xlDown)).Value

        For ele = LBound(TempArray, 1) To UBound(TempArray, 1)

            If Not PipeDict.Exists(Left(TempArray(ele, 1), Len(TempArray(ele, 1) - 2))) Then

                PipeDict.Add Key:=Left(TempArray(ele, 1), Len(TempArray(ele, 1) - 2)), _
                                                        Item:=Left(TempArray(ele, 1), Len(TempArray(ele, 1) - 2))

            End If

        Next ele

        TempArray = PipeDict.Items

        For ele = LBound(TempArray) To UBound(TempArray)
            MsgBox TempArray(ele)
        Next ele

    End With
    wbPreviousSummary.Close SaveChanges:=False

    Set wbPreviousSummary = Nothing 'done early so we dont have the information loaded in memory

Using a heap of message boxes for debugging atm - im sure you'll change it to suit your own work.

I hope people find this useful, Regards Joe

Improve this answer

1 Comment

please dont run that exact code - lots of missing variables and some of the string work was wrong at the time i posted it.
0

Deleting Elements in an Array if Element is a Certain value VBA

to delete elements in an Array wih certain condition, you can code like this

For i = LBound(ArrValue, 2) To UBound(ArrValue, 2)
    If [Certain condition] Then
        ArrValue(1, i) = "-----------------------"
    End If
Next i

StrTransfer = Replace(Replace(Replace(join(Application.Index(ArrValue(), 1, 0), ","), ",-----------------------,", ",", , , vbBinaryCompare), "-----------------------,", "", , , vbBinaryCompare), ",-----------------------", "", , , vbBinaryCompare)
ResultArray = join( Strtransfer, ",")

I often manipulate 1D-Array with Join/Split but if you have to delete certain value in Multi Dimension I suggest you to change those Array into 1D-Array like this

strTransfer = Replace(Replace(Replace(Replace(Names.Add("A", MultiDimensionArray), Chr(34), ""), "={", ""), "}", ""), ";", ",")
'somecode to edit Array like 1st code on top of this comment
'then loop through this strTransfer to get right value in right dimension
'with split function.
Improve this answer

Comments

0

I know this is old, but here's the solution I came up with when I didn't like the ones I found.

-Loop through the array (Variant) adding each element and some divider to a string, unless it matches the one you want to remove -Then split the string on the divider

tmpString=""
For Each arrElem in GlobalArray
   If CStr(arrElem) = "removeThis" Then
      GoTo SkipElem
   Else
      tmpString =tmpString & ":-:" & CStr(arrElem)
   End If
SkipElem:
Next
GlobalArray = Split(tmpString, ":-:")

Obviously the use of strings creates some limitations, like needing to be sure of the information already in the array, and as-is this code makes the first array element blank, but it does what I need and with a little more work it could be more versatile.

Improve this answer

1 Comment

nice and simple approach. needs a tad of tweaking though since the first value of the array will always automatically be blank
0

It's simple. I did it the following way to get a string with unique values (from two columns of an output sheet):

Dim startpoint, endpoint, ArrCount As Integer
Dim SentToArr() As String

'created by running the first part (check for new entries)
startpoint = ThisWorkbook.Sheets("temp").Range("A1").Value
'set counter on 0
Arrcount = 0 
'last filled row in BG
endpoint = ThisWorkbook.Sheets("BG").Range("G1047854").End(xlUp).Row

'create arr with all data - this could be any data you want!
With ThisWorkbook.Sheets("BG")
    For i = startpoint To endpoint
        ArrCount = ArrCount + 1
        ReDim Preserve SentToArr(1 To ArrCount)
        SentToArr(ArrCount) = .Range("A" & i).Value
        'get prep
        ArrCount = ArrCount + 1
        ReDim Preserve SentToArr(1 To ArrCount)
        SentToArr(ArrCount) = .Range("B" & i).Value
    Next i
End With

'iterate the arr and get a key (l) in each iteration
For l = LBound(SentToArr) To UBound(SentToArr)
    Key = SentToArr(l)
    'iterate one more time and compare the first key (l) with key (k)
    For k = LBound(SentToArr) To UBound(SentToArr)
        'if key = the new key from the second iteration and the position is different fill it as empty
        If Key = SentToArr(k) And Not k = l Then
            SentToArr(k) = ""
        End If
    Next k
Next l

'iterate through all 'unique-made' values, if the value of the pos is 
'empty, skip - you could also create a new array by using the following after the IF below - !! dont forget to reset [ArrCount] as well:
'ArrCount = ArrCount + 1
'ReDim Preserve SentToArr(1 To ArrCount)
'SentToArr(ArrCount) = SentToArr(h)

For h = LBound(SentToArr) To UBound(SentToArr)
    If SentToArr(h) = "" Then GoTo skipArrayPart
    GetEmailArray = GetEmailArray & "; " & SentToArr(h)
skipArrayPart:
Next h

'some clean up
If Left(GetEmailArray, 2) = "; " Then
    GetEmailArray = Right(GetEmailArray, Len(GetEmailArray) - 2)
End If

'show us the money
MsgBox GetEmailArray
Improve this answer

Comments

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.