Delete specific element of an array 4

[nickd87]

Hello

I apologise if this has been answered elsewhere, but I could not find it.

Say I have an array with 12 elements and I want to erase the 5th element, is there a way I can do this in VB6?

The only way I can think of is looping through the remaining 7 and reassigning them to an index 1 less than they already are (eg tmpArray(5) = tmparray(7-1)).

Thanks

 

[SBerthold]

Is the element unique?

 

[jadams0173]

The way I've done it in the past is by building a temp array and leaving out the the element I want to delete. Then put the temp array back into the original.

Recently if the array met the criteria of fitting into a dictionary I've used the dictionary. It has a Remove, Exists and Add method which makes manipulating it somewhat easier than an array.

Here is a good overview of what a dictonary is and how to use it.

 

[nickd87]

SBerthold,

Yes, it is.

Thanks jadams, I'll check it out.

 

[SBerthold]

Oh, I should have also asked it this is a string array or not.

 

[BobRodes]

Oho. That's what you're up to. (Shifting memory locations, is it?)

 

[nickd87]

Yes, it is a string array. But would you mind pointing out any other considerations I should have in the case that I need to do it to a Integer or Long array?

Thanks for your help so far.

 

[SBerthold]

Here is a simple method if no sorting is needed (you could just use the classic sorting for this). Just change the array type for other types:

Public Sub ArraySimpleDelete(MyArray() As String, IndexToRemove As Long)
    MyArray(IndexToRemove) = MyArray(UBound(MyArray()))
    ReDim Preserve MyArray(UBound(MyArray) - 1) As String
End Sub

You can use a CopyMemory to also change strings. The following deletes the requested element by first swapping the last element with the one to be deleted, and then deleting the last element. Basically the same as the one above without sorting. A sorting technique using CopyMemory is also included. Drop this (and following that, add the code above) into a bas module:

Option Explicit
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Public Sub ArrayDeleteElementCM(MyArray() As String, IndexToRemove As Long, Optional bSort As Boolean)

    Call StringsChangeCM(MyArray(IndexToRemove), MyArray(UBound(MyArray)))
    ReDim Preserve MyArray(UBound(MyArray) - 1) As String
    If bSort Then Call ArraySortCM(MyArray())
    
End Sub
Private Sub StringsChangeCM(sElement1 As String, sElement2 As String)
    Dim ldest As Long, lLen As Long
    lLen = 4&
    Call CopyMemory(ldest, ByVal VarPtr(sElement1), lLen)
    Call CopyMemory(ByVal VarPtr(sElement1), ByVal VarPtr(sElement2), lLen)
    Call CopyMemory(ByVal VarPtr(sElement2), ldest, lLen)
    
End Sub

Public Sub ArraySortCM(MyArray() As String)
    Dim iOuterL As Long, iInnerL As Long, lUBound As Long
    
    lUBound = UBound(MyArray)
    
    For iOuterL = 0 To lUBound
        For iInnerL = iOuterL + 1 To lUBound
            If MyArray(iOuterL) > MyArray(iInnerL) Then
                StringsChangeCM MyArray(iOuterL), MyArray(iInnerL)
            End If
        Next
    Next
    
End Sub

And, here is a simple test routine. Add a form with a command button called "Command1". Check the debug window for the results:
Public Sub Command1_Click()
Dim i As Integer, iAry As Long
Dim sMsg As String

For i = 1 To 3
ReDim MyArray(3) As String
MyArray(0) = String(50, "A")
MyArray(1) = String(50, "B")
MyArray(2) = String(50, "C")
MyArray(3) = String(50, "D")

'Remove the "B"s
If i = 1 Then
sMsg = "ArraySimpleDelete Unsorted: "
Call ArraySimpleDelete(MyArray(), 1)
ElseIf i = 2 Then
sMsg = "ArrayDeleteElementCM CopyMemory Unsorted: "
Call ArrayDeleteElementCM(MyArray(), 1, 0)
ElseIf i = 3 Then
sMsg = "ArrayDeleteElementCM CopyMemory Sorted: "
Call ArrayDeleteElementCM(MyArray(), 1, 1)
End If
'Test results

Debug.Print sMsg
For iAry = 0 To UBound(MyArray())
Debug.Print MyArray(iAry)
Next iAry
Debug.Print
Next i
End Sub

Some good info here at tek-tips. You might want to check out some other threads and learn more about CopyMemory(thread711-763982, thread222-1096338, thread222-1079449, thread222-1181777, thread222-1201658)

 

[nickd87]

thank you very much! Incredibly helpful and detailed as usual.

 

[jadams0173]

Most helpful to me. Now I just need to try to understand what's happening. I've got some reading to do. In the mean time enjoy the pinkie SBerthold!

 

[BobRodes]

Very nice, SB. Another star.

 

[harebrain]

Me too. (*) I learned something I had forgotten.

 

[SBerthold]

you are all welcome, and thanked.