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

user_836054 0
Viewed 178745

I have a global array, prLst() that 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

element vba excel arrays
8 Answers

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
user_46896140
Related