CODEWITHSUNDEEP
arraysvbaexceldebugging
Katrina
Katrina

Reputation: 51

How can i fix this code that removes all non-zero elements from one array from another in VBA?

I have written some code that removes all non-zero terms from one array from another. But it has some bugs and I can't seem to solve it. for instance if

A(1) = 0 
A(2) = 3
A(3) = 0 
A(4) = 4
for i = 1 to 4
    B(i) = i
next i

I want B to look like this after

B= (1, 2)

For i = 1 To UBound(A) - 1
If A(i) <> 0 Then
    count = count + 1 
End If
Next i

For j = 1 To count
k = 1
Do While k < UBound(A)
If A(k) <> 0 Then 'If A is not equal to 0
    A(k) = m
    For i = m To UBound(B) - 1
        B(i) = B(i + 1)
    Next i
    ReDim Preserve B(1 To UBound(B) - 1)
Else
End If
k = k + 1
Loop

Upvotes: 1

Views: 196

Answers (2)

Benjamin F
Benjamin F

Reputation: 1

Does this do the job for you?

Dim A(4) As Integer
Dim B() As Integer
Dim i As Integer
Dim j As Integer

A(1) = 0
A(2) = 3
A(3) = 0
A(4) = 4

j = 1

For i = 1 To UBound(A)
    If A(i) = 0 Then
        ReDim Preserve B(j)
        B(j) = i
        j = j + 1
    End If
Next i

Upvotes: 0

PeterT
PeterT

Reputation: 8557

A ReDim Preserve is not necessary because you have all the information you need after you count the number of non-zero items in your original array. Here's an example:

Option Explicit

Sub test()
    Dim testdata() As Variant
    Dim resultdata() As Variant
    testdata = Array(2, 1, 0, 3, 0, 4, 2, 4, 5, 0, 0, 3, 6, 0, 0, 1)
    RemoveZeros testdata, resultdata
    Debug.Print "Original array len= " & UBound(testdata)
    Debug.Print "Results  array len= " & UBound(resultdata)
End Sub

Function RemoveZeros(ByRef inputArray() As Variant, _
                     ByRef outputArray() As Variant) As Variant
    Dim numNonZeros As Long
    Dim i As Long
    Dim j As Long

    numNonZeros = 0
    For i = LBound(inputArray) To UBound(inputArray)
        If inputArray(i) <> 0 Then
            numNonZeros = numNonZeros + 1
        End If
    Next i
    If numNonZeros > 0 Then
        '--- create the array and load it up
        j = 1
        ReDim outputArray(j To numNonZeros)
        For i = LBound(inputArray) To UBound(inputArray)
            If inputArray(i) <> 0 Then
                outputArray(j) = inputArray(i)
                j = j + 1
            End If
        Next i
    Else
        ReDim outputArray(1 To 1)
        outputArray(1) = 0
    End If
    RemoveZeros = outputArray
End Function

Upvotes: 1

Related Questions