Removing 1 item from a dynamic array?

Can anyone show me an example of how to remove a single item from an array?
For example, if I have added items to an array to get this:

item1
item2
item3
item4
item5

and I need to remove item3 so the array now consists of this:

item1
item2
item4
item5

The catch being that I wouldn't know an exact number or index position - all
I have is partial text string to match. So in this example I would be
using: Like "*3" somewhere... right?

This ties into my earlier question about identifying the total number of
items in a dynamic array...

 

The way I have done it in the past is to swap items 3 and 5 then do a
redim preserve array(4). I don't know of a better way. if it were a
listbox then you could just do a
x = me.ListBox1.ListIndex
listbox1.removeitem x

If there is a better way for an array I would like to know.

David Urban

 

my opinion: abandon arrays, use collections

array?

 

I'd be happy to - after reading your other reply it sounds like a much
easier option. Unfortunately for me, I know less about creating a
collection than I do an array! I thought collections were built in - I did
not know you could make your own. Or can you? Could you toss out an
example?

 

Sub TestCollection()
Dim colStuff as New Collection
colStuff.Add "Whatever"
colStuff.Add "Whatever else"
dim i as integer
for i = 1 to 25
colStuff.Add i
next

colStuff.Add "Even more stuff"
colStuff.Add "Even more stuff"
colStuff.Add "Whatever else"
colStuff.Add "Even more stuff"

for i = 1 to colStuff.count
debug.print colStuff(i)
next

set colStuff = Nothing


end sub

note collections are 1 based where arrays are (usually) 0 based

 

Forget collections as well. Use a Dictionary - Microsoft's not Autodesk's.
It takes collections to the next level - AND includes a remove item method.
Here is an example of late-binding to it:

Dim mDict As Object
Set mDict = CreateObject("Scripting.Dictionary")

Paste the code with a break and play with the mDict in the immediate window
while your code is broken. You could also just set a reference to the
Microsoft Scripting Runtime and use the object browser tto explore it.

 

Right!
I always forget about that one.
Seems like I've seen some comments about why not to use them, but if you're
recommending them that's enough for me!

now to retrain my habits!!!
Thanks
Mark

 

I have array routines I use all the time for removing items , adding unique
items, and qsorting. Then one day I realized I could make a collection instead
of an array. The only thing that seemed to make easier was removing items and
knowing the count. But there is still the problem with adding unique and
sorting. All of this code was created for dealing with list and combo boxes.
If only the collection class and list classes were not so short sighted. I
can post some of the stuff. It is rude and crude, but it gets the job done and
is easily transported.

 

Thanks, Mark and Mike - It seems collections are easier than I thought...
Certainly easier than an array in this case.

Thanks for all the details, much appreciated!

 

Hmmm.... only reasons I can think of are:

1. Purist - sticking to just what vba offers
2. Possibly some incompatability between different OSs

I use it all the time and haven't run into any issues with it. One of my
most common implementations is using it with a text file *if* the
customer's other software that I am integrating with only kicks out text.
I'll populate the dict with the text data so I can search, etc.

'Course if there is a valid argument against it, I'd have to re-asses my
approach

Mike

 

I'm definitely not certain (hows that for a phrase? ) that there are any
valid reasons against it.
....just a little dust floating in the back of my cobwebbed brain hollows
that thought it heard something somewhere once maybe...uh....hmm....

The other aspect I've considered in regard to either collections or
dictionaries is *if* I need to store info - either in the dwg or otherwise -
then I need to transfer the data from the temporary storage to an acad
dictionary or store it in xml or text or whatever and somehow key that file
to the dwg.

Thats why I need to study your other example on xml - so that it could be
transferred from the scripting dict (since that will be a convenient though
transient storage medium).

 

If you want a more detailed example on xml, let me know. The one posted is
very basic and uses a SQL query against it instead of a normal parser.

 

oooh oooh oooh!
Yes please, that'd be really nice!
I got the two references installed/ the vbaccelerator treeview control and
the 2.8mdac
and that's a great little example of using different storage mediums for the
same info.

a further example on xml would be much appreciated....
always easier to learn from a few actual examples than reems of msdn pages!
Thanks in advance
Mark

 

I wrote an XML reader and writer that uses the parser. It uses a simple
file that I save my UDT to and load my UDT from each time. I found
documentation on how to use an XML file in VB very sparse. Thanks MS.
I have attached my file.

David Urban

Attribute VB_Name = "XML"
Option Explicit
Public Sub Save_toXML()
Dim oDoc As DOMDocument

Dim oAlg As IXMLDOMElement
Dim oSta As IXMLDOMElement
Dim oLat1 As IXMLDOMElement
Dim oLat2 As IXMLDOMElement
Dim oRoot As IXMLDOMElement
Dim oStation As IXMLDOMAttribute

Set oDoc = Nothing

Set oDoc = New DOMDocument
oDoc.async = False

On Error Resume Next
oDoc.Load (fXMLFile)
Set oRoot = oDoc.documentElement
'If Err.Number <> 0 Then
oDoc.resolveExternals = True
If oDoc.parseError <> 0 Then
' Create processing instruction and document root
Set oAlg = oDoc.createProcessingInstruction("xml", "version='1.0'")
Set oAlg = oDoc.insertBefore(oAlg, oDoc.childNodes.Item(0))

' Create document root
Set oRoot = oDoc.createElement("Project_" & CStr(Project))
Set oDoc.documentElement = oRoot
' oRoot.setAttribute "xmlns:dt", "urn:schemas-microsoft-com:datatypes"

'Else
'Set oRoot = oDoc.documentElement
End If
Err.Clear
Dim events As Variant, alignName As String
Dim x As Integer, name As String, name2 As String
name = Replace(algname, " ", "_")
alignName = "//Project_" & CStr(Project) & "//" & name
Set oAlg = oDoc.selectSingleNode(alignName)
name2 = oAlg.baseName
If name2 <> "" Then
oRoot.removeChild oAlg
End If
Set oAlg = oDoc.createElement(name)
oRoot.appendChild oAlg
For x = LBound(AlignPt, 1) To UBound(AlignPt, 1)
Set oSta = oDoc.createElement("Sta" & Format(AlignPt(x).Station, "0.00"))
oAlg.appendChild oSta
Write_XMLStation oSta, oDoc, AlignPt(x)
Next x



' Save xml file
oDoc.Save fXMLFile

End Sub
Public Function Load_fromXML() As Boolean
Dim oDoc As DOMDocument
Dim oAlg As IXMLDOMNode, nodes As IXMLDOMNode
Dim oSta As IXMLDOMElement
Dim oLat1 As IXMLDOMElement
Dim oLat2 As IXMLDOMElement

Set oDoc = Nothing

Set oDoc = New DOMDocument
oDoc.async = False

On Error Resume Next
oDoc.Load (fXMLFile)
'Set oRoot = oDoc.documentElement
'If Err.Number <> 0 Then
oDoc.resolveExternals = True
If oDoc.parseError = 0 Then

Dim alignName As String
Dim x As Integer, name As String, name2 As String
name = Replace(algname, " ", "_")
alignName = "//Project_" & CStr(Project) & "//" & name
Set oAlg = oDoc.selectSingleNode(alignName)
Debug.Print Err.Number
name2 = oAlg.baseName
If name2 <> "" Then
Debug.Print Err.Number
ReDim AlignPt(oAlg.childNodes.length - 1)
For x = 0 To oAlg.childNodes.length - 1
Set oSta = oAlg.childNodes.Item(x)
Read_XMLStation oSta, AlignPt(x)
Next x
Load_fromXML = True
End If
End If
Set oDoc = Nothing

End Function
Public Function Delete_Sta_fromXML(Station) As Boolean
Dim oDoc As DOMDocument
Delete_Sta_fromXML = False
Dim oAlg As IXMLDOMElement
Dim oSta As IXMLDOMNode
Dim oRoot As IXMLDOMElement, oTree As IXMLDOMNamedNodeMap

Set oDoc = Nothing

Set oDoc = New DOMDocument
oDoc.async = False

On Error Resume Next
oDoc.Load (fXMLFile)
Set oRoot = oDoc.documentElement
If Err.Number = 0 Then
oDoc.resolveExternals = True
If oDoc.parseError = 0 Then
Dim alignName As String
Dim x As Integer, name As String
name = Replace(algname, " ", "_")
alignName = "//Project_" & CStr(Project) & "//" & name
Set oAlg = oDoc.selectSingleNode(alignName)
alignName = "//Project_" & CStr(Project) & "//" & name & "//" & "Sta" & Format(Station, "0.00")
Set oSta = oDoc.selectSingleNode(alignName)
oAlg.removeChild oSta
oDoc.Save fXMLFile
Delete_Sta_fromXML = True
End If
End If
End Function
Public Function Update_station(temp As junctions) As Boolean
Dim oDoc As DOMDocument
Update_station = False
Dim oAlg As IXMLDOMNode, nodes As IXMLDOMNode
Dim oSta As IXMLDOMElement
Dim oLat1 As IXMLDOMElement
Dim oLat2 As IXMLDOMElement
Update_station = False

Set oDoc = Nothing
Set oDoc = New DOMDocument
oDoc.async = False
Err.Clear: On Error Resume Next
oDoc.Load (fXMLFile)
If Err.Number = 0 Then
oDoc.resolveExternals = True
If oDoc.parseError = 0 Then
Dim alignName As String
Dim x As Integer, name As String, name2 As String
name = Replace(algname, " ", "_")
alignName = "//Project_" & CStr(Project) & "//" & name
Set oAlg = oDoc.selectSingleNode(alignName)
alignName = "//Project_" & CStr(Project) & "//" & name & "//" & "Sta" & Format(temp.Station, "0.00")
Set oSta = oDoc.selectSingleNode(alignName)
Debug.Print Err.Number
name2 = oSta.baseName
If name2 <> "" Then
oAlg.removeChild oSta
End If
Set oSta = oDoc.createElement("Sta" & Format(temp.Station, "0.00"))
oAlg.appendChild oSta
Write_XMLStation oSta, oDoc, temp
oDoc.Save fXMLFile
Update_station = True
End If
End If
End Function

Private Sub Write_XMLStation(oSta As IXMLDOMElement, oDoc As DOMDocument, temp As junctions)
Dim oLat1 As IXMLDOMElement, oLat2 As IXMLDOMElement
oSta.setAttribute "Station", temp.Station
oSta.setAttribute "Event", temp.Event
oSta.setAttribute "Direction", temp.Direction
oSta.setAttribute "DirectionUP", temp.DirectionUP
oSta.setAttribute "Easting", temp.Easting
oSta.setAttribute "Northing", temp.Northing
oSta.setAttribute "Pipesize", temp.Pipesize
oSta.setAttribute "PipesizeUP", temp.PipesizeUP
oSta.setAttribute "Flowline", temp.FlowLine
Set oLat1 = oDoc.createElement("Lateral1")
oSta.appendChild oLat1
oLat1.setAttribute "name", temp.Lateral1.name
oLat1.setAttribute "Station", temp.Lateral1.INTStation
oLat1.setAttribute "count", temp.Lateral1.count
oLat1.setAttribute "Direction", temp.Lateral1.Direction
oLat1.setAttribute "eEast", temp.Lateral1.EndEasting
oLat1.setAttribute "eNorth", temp.Lateral1.EndNorthing
oLat1.setAttribute "eSta", temp.Lateral1.EndStation
Set oLat2 = oDoc.createElement("Lateral2")
oSta.appendChild oLat2
oLat2.setAttribute "name", temp.Lateral2.name
oLat2.setAttribute "Station", temp.Lateral2.INTStation
oLat2.setAttribute "count", temp.Lateral2.count
oLat2.setAttribute "Direction", temp.Lateral2.Direction
oLat2.setAttribute "eEast", temp.Lateral2.EndEasting
oLat2.setAttribute "eNorth", temp.Lateral2.EndNorthing
oLat2.setAttribute "eSta", temp.Lateral2.EndStation

End Sub
Private Sub Read_XMLStation(oSta As IXMLDOMElement, temp As junctions)
Dim oLat1 As IXMLDOMElement, oLat2 As IXMLDOMElement
With temp
.Station = oSta.getAttribute("Station")
.Event = oSta.getAttribute("Event")
.Direction = oSta.getAttribute("Direction")
.DirectionUP = oSta.getAttribute("DirectionUP")
.Easting = oSta.getAttribute("Easting")
.Northing = oSta.getAttribute("Northing")
.Pipesize = oSta.getAttribute("Pipesize")
.PipesizeUP = oSta.getAttribute("PipesizeUP")
.FlowLine = oSta.getAttribute("Flowline")
Set oLat1 = oSta.firstChild
.Lateral1.name = oLat1.getAttribute("name")
.Lateral1.INTStation = oLat1.getAttribute("Station")
.Lateral1.count = oLat1.getAttribute("count")
.Lateral1.Direction = oLat1.getAttribute("Direction")
.Lateral1.EndEasting = oLat1.getAttribute("eEast")
.Lateral1.EndNorthing = oLat1.getAttribute("eNorth")
.Lateral1.EndStation = oLat1.getAttribute("eSta")
Set oLat2 = oSta.lastChild
.Lateral2.name = oLat2.getAttribute("name")
.Lateral2.INTStation = oLat2.getAttribute("Station")
.Lateral2.count = oLat2.getAttribute("count")
.Lateral2.Direction = oLat2.getAttribute("Direction")
.Lateral2.EndEasting = oLat2.getAttribute("eEast")
.Lateral2.EndNorthing = oLat2.getAttribute("eNorth")
.Lateral2.EndStation = oLat2.getAttribute("eSta")
End With
End Sub
Public Function read_rec_fromXML(alignmentName As String, Station As Double, Xtemp As junctions) As Boolean
Dim oDoc As DOMDocument
read_rec_fromXML = False
Dim oAlg As IXMLDOMNode, nodes As IXMLDOMNode
Dim oSta As IXMLDOMElement
Dim oLat1 As IXMLDOMElement
Dim oLat2 As IXMLDOMElement

Set oDoc = Nothing
Set oDoc = New DOMDocument
oDoc.async = False
Err.Clear: On Error Resume Next
oDoc.Load (fXMLFile)
If Err.Number = 0 Then
oDoc.resolveExternals = True
If oDoc.parseError = 0 Then
Dim alignName As String
Dim x As Integer, name As String, name2 As String
name = Replace(alignmentName, " ", "_")
alignName = "//Project_" & CStr(Project) & "//" & name
Set oAlg = oDoc.selectSingleNode(alignName)
alignName = "//Project_" & CStr(Project) & "//" & name & "//" & "Sta" & Format(Station, "0.00")
Set oSta = oDoc.selectSingleNode(alignName)
Debug.Print Err.Number
name2 = oSta.baseName
If name2 <> "" Then
Read_XMLStation oSta, Xtemp
read_rec_fromXML = True
End If
End If
End If
End Function
Public Function delete_begin_end(events As String) As Boolean
Dim oDoc As DOMDocument
Dim oAlg As IXMLDOMNode, nodes As IXMLDOMNode
Dim oSta As IXMLDOMElement
Dim oLat1 As IXMLDOMElement
Dim oLat2 As IXMLDOMElement
Update_station = False

Set oDoc = Nothing
Set oDoc = New DOMDocument
oDoc.async = False
Err.Clear: On Error Resume Next
oDoc.Load (fXMLFile)
If Err.Number = 0 Then
oDoc.resolveExternals = True
If oDoc.parseError = 0 Then
Dim alignName As String
Dim x As Integer, name As String, name2 As String
name = Replace(algname, " ", "_")
alignName = "//Project_" & CStr(Project) & "//" & name
Set oAlg = oDoc.selectSingleNode(alignName)
Set oSta = oAlg.firstChild
While oAlg.nextSibling <> oAlg.lastChild
Select Case events
Case "Begin"
If oSta.getAttribute("Event") = "Begin Construction" Then
oAlg.removeChild oSta
End If
Case "End"
If oSta.getAttribute("Event") = "End Construction" Then
oAlg.removeChild oSta
End If
End Select
Set oSta = oAlg.nextSibling
Wend
End If
End If
End Function

 

Thanks David, for that sample.
I'll be studying that as soon as i dig out from under this pile of work!
Mark