Thanks for your responces tho, but I've already figured out you have to assing the key as well, and btw heres the code so far in SicCodes.cls, with the exception that some properties has been added to other collections.<br>
(also i cant have Lists involded in my code, must be completely self contained, now just to figure out how to export the collection)<br>
<br>
Public Shapes As New Collection<br>
<br>
Public Sub SicShape(Name As String, ShapeType As String, Sic As String, Desc As String, employers As String)<br>
' Add entire Shape's Sic code tree, if Sic2 was added under shape, then all Sic4s that follow it are added too<br>
On Error GoTo SError<br>
Dim NewSh As New Shapes<br>
Dim NewS2 As New Sic2<br>
Dim NewS4 As New Sic4<br>
Dim idx As Integer<br>
Dim sicid As String<br>
Dim bExists As Boolean<br>
Dim objSicStuff As Object<br>
Set objSicStuff = CreateObject("wiDataAccess.Dataconnection"

<br>
<br>
objSicStuff.ConnectionString = "dsn=siccode;uid=sa;pwd;"<br>
objSicStuff.Connect<br>
<br>
If Desc = "" Then<br>
Desc = objSicStuff.GetSicTitle(Sic)<br>
End If<br>
<br>
'Dont know if this next line will work<br>
bExists = True<br>
Set NewSh = Shapes.Item(Name)<br>
sicid = Trim(Sic)<br>
If Len(sicid) = 2 Then<br>
NewS2.SicDesc = Desc<br>
NewS2.SicCode = sicid<br>
NewS2.total = 0<br>
<br>
Set rs = objSicStuff.GetSic4Titles(sicid)<br>
Do While Not rs.EOF<br>
NewS4.SicCode = rs!SicCode<br>
NewS4.SicDesc = rs!sictitle<br>
NewS2.Sic4.Add NewS4, rs!SicCode<br>
NewS2.total = NewS2.total + 1<br>
Set NewS4 = New Sic4<br>
rs.movenext<br>
Loop<br>
NewS2.SEmploy = employers<br>
NewSh.Sic2.Add NewS2, sicid<br>
<br>
Else<br>
NewS4.SicCode = sicid<br>
NewS4.SicDesc = Desc<br>
NewS4.SEmploy = employer<br>
NewSh.Sic4.Add NewS4, sicid<br>
End If<br>
If bExists = False Then<br>
NewSh.Name = Name<br>
NewSh.SType = ShapeType<br>
NewSh.SDesc = Desc<br>
Shapes.Add NewSh, Name<br>
End If<br>
<br>
Exit Sub<br>
SError:<br>
If Err.Number = 5 Then<br>
Debug.Print Err.Description + " occured in SicShape"<br>
bExists = False<br>
End If<br>
Err.Clear<br>
Resume Next<br>
Exit Sub<br>
<br>
End Sub<br>
<br>
Public Sub ShapeRemove(Name As String)<br>
On Error GoTo DError<br>
Shapes.Remove (Name)<br>
Exit Sub<br>
DError:<br>
If Err.Number = 5 Then<br>
Debug.Print Err.Description + " Occured in Shape Remove"<br>
Err.Clear<br>
Resume Next<br>
End If<br>
Debug.Print "Unknown Error: " + Err.Number + " " + Err.Description + " in Shape Remove"<br>
End Sub<br>
<br>
Public Sub ShapeClear()<br>
Dim Num As Integer<br>
For Num = 1 To Shapes.Count<br>
Shapes.Remove 1<br>
Next Num<br>
<br>
End Sub<br>
<br>
Public Sub ShapeChange(OldName As String, NewName As String, SicCode As String)<br>
On Error GoTo CError<br>
Dim OldSH As Shapes<br>
Dim OldS2 As Sic2<br>
Dim OldS4 As Sic4<br>
Dim NewSh As New Shapes<br>
Dim Exists As Boolean<br>
<br>
Exists = True<br>
Set OldSH = Shapes.Item(OldName)<br>
If Exists = False Then<br>
Exit Sub<br>
End If<br>
For Each OldS2 In OldSH.Sic2<br>
NewSh.Sic2.Add OldS2<br>
Next<br>
For Each OldS4 In OldSH.Sic4<br>
NewSh.Sic4.Add OldS4<br>
Next<br>
NewSh.Name = NewName<br>
Shapes.Add NewSh, NewName<br>
Shapes.Remove OldName<br>
Exit Sub<br>
CError:<br>
Debug.Print Err.Description + " occured in ShapeChange"<br>
Exists = False<br>
Err.Clear<br>
Resume Next<br>
End Sub<br>
<br>
Sub SRemoveSic(Shape As String, Sic As String)<br>
On Error GoTo SRError<br>
Dim SicSH As Shapes<br>
Sic = Trim(Sic)<br>
Dim Exists As Boolean<br>
Exists = True<br>
Set SicSH = Shapes.Item(Shape)<br>
If Exists = False Then Exit Sub<br>
If Len(Sic) = 2 Then<br>
SicSH.Sic2.Remove Sic<br>
Else<br>
SicSH.Sic4.Remove Sic<br>
End If<br>
<br>
SRError:<br>
Debug.Print Err.Description + " occured in SicRemove"<br>
Exists = False<br>
Err.Clear<br>
Resume Next<br>
End Sub<br>
<br>
<p>Karl<br><a href=mailto:kb244@kb244.8m.com>kb244@kb244.8m.com</a><br><a href=
</a><br>Experienced in , or have messed with : VC++, Borland C++ Builder, VJ++6(starting),VB-Dos, VB1 thru VB6, Delphi 3 pro, Borland C++ 3(DOS), Borland C++ 4.5, HTML, ASP(somewhat), QBasic(least i didnt start with COBOL)