Results 1 to 4 of 4
  1. #1
    Thompyt is offline Expert
    Windows 8 Access 2010 32bit
    Join Date
    Sep 2014
    Location
    El Paso, TX
    Posts
    839

    I think I have the count

    Now how do I get this to a New table?

    Code:
    Private Sub Loop_Test_Equip_Click()
    Dim db As DAO.Database
    Dim rS As DAO.Recordset, HB As DAO.Recordset, rST As Recordset
    Dim CtrPlat As Integer, CtrMEquip As Integer, CtrDisMEquip As Integer, CtrFE As Integer
    Dim PlatArr As Variant, FEArr As Variant, MEquipArr As Variant, DEquipArr As Variant
    Set db = CurrentDb()
    Set rS = CurrentDb.OpenRecordset("SELECT [Row Type], Count(*) AS CntType FROM Table1 GROUP BY [Row Type]")
    While Not rS.EOF
        If rS![Row Type] = "PLAT" Then
            ReDim PlatArr(1 To rS!CntType, 1 To 9)
        ElseIf rS![Row Type] = "FE" Then
            ReDim FEArr(1 To rS!CntType, 1 To 9)
        ElseIf rS![Row Type] = "MEQUIP" Then
            ReDim MEquipArr(1 To rS!CntType, 1 To 8)
        ElseIf rS![Row Type] = "DISMEQUIP" Then
            ReDim DEquipArr(1 To rS!CntType, 1 To 9)
        End If
    Wend
        rS.Close
        
        'Sets count to 0
        CtrPlat = 0
        CtrFE = 0
        CtrMEquip = 0
        CtrDisMEquip = 0
       
        'Stores the information in an array for later use
    Set rST = CurrentDb.OpenRecordset("Table1")
    Do While Not rST.EOF
        rST.Edit
           
        'Mounted Equipment
        If rST![Row Type] = "MEQUIP" Then
            CtrMEquip = CtrMEquip + 1
                MEquipArr(CtrMEquip, 1) = rS![unique_id]                            'Unique_ID
                MEquipArr(CtrMEquip, 2) = rS![Equip HB Name]                        'HB Name
                    If rS![Networks] <> "" Then
                        MEquipArr(CtrMEquip, 3) = "[" & rST![Networks] & "]"         'Assigned Network
                    End If
                    If rS![parent_equipment_item_id] = rST![platform_id] Then        'parent_equipment and platform ID's are the same, it's not needed, Node ID maps to the Platform
                        MEquipArr(CtrMEquip, 4) = ""
                    Else: MEquipArr(CtrMEquip, 4) = rST![parent_equipment_item_id]
                End If
                MEquipArr(CtrMEquip, 5) = rST![materiel_shading]                     'Materiel shading color
                MEquipArr(CtrMEquip, 6) = rST![materiel_text_coloring]               'Materiel text color
                MEquipArr(CtrMEquip, 7) = rST![platform_id]                          'platform_id
        'Pesonnel
        ElseIf rST![Row Type] = "FE" Then
            CtrFE = CtrFE + 1
                FEArr(CtrFE, 1) = rST![(Role / FE / Node ID]                         'VisioID will be NodeID
                FEArr(CtrFE, 2) = rST![Unit]                                         '(BN) Unit
                FEArr(CtrFE, 3) = rST![TOE Title]                                    '(CO) TOE Title
                FEArr(CtrFE, 4) = rST![Para Desc]                                    '(PLT/SEC) Para Desc
                FEArr(CtrFE, 5) = rST![Role / FE Rank]                               'Rank
                FEArr(CtrFE, 6) = rST![Role / FE MOS]                                'Role
                    If rST![Equip HB Name] = "." Then                                'if equipment name is a period then its a Soldier
                        FEArr(CtrFE, 7) = "Soldier"
                    Else: FEArr(CtrFE, 7) = rST![Equip HB Name]                      'HB Name
                    End If
                FEArr(CtrFE, 8) = rST![Bumper # / Plat ID]                           'Bumper #
                FEArr(CtrFE, 9) = rST![platform_shading]                             'Platform Shading
        'Vehicles
        ElseIf rST![Row Type] = "PLAT" Then
            CtrPlat = CtrPlat + 1
                PlatArr(CtrPlat, 1) = rST![Parent Node ID] & "-" & rS![platform_id]  'Node_ID-Platform_ID
                PlatArr(CtrPlat, 2) = rST![Unit]                                     '(BN) Unit
                PlatArr(CtrPlat, 3) = rST![TOE Title]                                '(CO) TOE Title
                PlatArr(CtrPlat, 4) = rST![Para Desc]                                '(PLT/SEC) Para Desc
                PlatArr(CtrPlat, 5) = rST![Role / FE MOS]                            'Role
                PlatArr(CtrPlat, 6) = rST![Role / FE Rank]                           'Rank
                PlatArr(CtrPlat, 7) = rST![Equip HB Name]                            '(Platform type) Equip HB name
                PlatArr(CtrPlat, 8) = rST![Bumper # / Plat ID]                       'Bumper #
                PlatArr(CtrPlat, 9) = rST![platform_shading]                         'Platform Shading
        
        'Dismounted Equipment
        ElseIf rST![Row Type] = "DISMEQUIP" Then
            CtrDisMEquip = CtrDisMEquip + 1
                DEquipArr(CtrDisMEquip, 1) = rST![unique_id]                         'Unique_ID
                DEquipArr(CtrDisMEquip, 2) = rST![Equip HB Name]                     'HB Name
                    If rS![Networks] <> "" Then
                        MEquipArr(CtrMEquip, 3) = "[" & rST![Networks] & "]"         'Assigned Network
                    End If
                DEquipArr(CtrDisMEquip, 4) = rST![parent_equipment_item_id]          'Parent_equipment_ID
                DEquipArr(CtrDisMEquip, 5) = rST![materiel_shading]                  'Materiel shading color
                DEquipArr(CtrDisMEquip, 6) = rST![materiel_text_coloring]            'Materiel text color
                DEquipArr(CtrDisMEquip, 7) = rST![Role / FE / Node ID]               'Node ID
        End If
        rST.MoveNext
    Loop
        rST.Close
    Dim MntdGrp As Collection                                                       'list of different Platform IDs for Mounted equipment
    Dim DisMtdGrp As Collection                                                     'list of different Node IDs for Dismounted equipment
    Dim CtrGrp As Integer, R As Integer
    Set MntdGrp = New Collection
    Set DisMtdGrp = New Collection
        MntdGrp.Add MEquipArr(1, 7)                                                 'platform_id
        CtrGrp = 1
        For R = 1 To CtrMEquip
            If MEquipArr(R, 7) <> MntdGrp(CtrGrp) Then
                MntdGrp.Add MEquipArr(R, 7)
                CtrGrp = CtrGrp + 1
            End If
        Next R
        
        DisMtdGrp.Add DEquipArr(1, 7)                                               'Node_id
        CtrGrp = 1
        For R = 1 To CtrDisMEquip
            If DEquipArr(R, 7) <> DisMtdGrp(CtrGrp) Then
                DisMtdGrp.Add DEquipArr(R, 7)
                CtrGrp = CtrGrp + 1
            End If
        Next R
    Dim HBArr As Variant, PlatSys As Variant
    Dim PlatItem As Object, BaseItem As Object
    Dim SubEquipItem As Object, PlatAlignItem As Object
    Dim PlatEquip As Collection, PlatAlignEquip As Collection                       'list of all equipment that belongs to a Platform system 'Collects all the data into 1 array where the info aligns by platform
    Dim PlatBaseEquip As Collection, PlatSubEquip As Collection                     'list of equipment aligned in chronological order (parent-kid-g_kid-g_g_kid) to a Platform system 'subset of PlatBaseEquip who are siblings
    Dim RowNum As Integer, RowEquip As Integer, CtrG As Integer
    Dim ColNum As Integer, SubItemKey As Integer, ParKey As Integer
    Dim RowSubEquip As Integer, RowLastSub As Integer
    Dim RowSub As Integer, PlatKey As Integer, PlatBaseEquipKey As Integer
    Dim EquipValue As String, ParID() As String, PlatEquipSplit() As String
    Dim ParExists As String, SubEquipSplit As String, strVal As String
    Dim PlatBaseEquipSplit() As String, SubItemSplit() As String
    Set PlatEquip = New Collection                                                 'list of all equipment that belongs to a Platform system
    Set PlatBaseEquip = New Collection                                             'list of equipment aligned in chronological order (parent-kid-g_kid-g_g_kid) to a Platform system
    Set PlatSubEquip = New Collection
    Set PlatAlignEquip = New Collection
    ReDim HBArr(1 To MntdGrp.Count + DisMtdGrp.Count, 1 To 44)
        
        RowNum = 1                                                                  'Platform array counter, to not start from the begining of each loop
        RowEquip = 1                                                                'equip_arr counter to not start from the begining of each loop
        CtrG = 0                                                                    'Tracks rows for the HBArr by grouped equipment counts
                
    For Each PlatSys In MntdGrp                                                     'Each Mounted equipment group is a row in the HBArr
        For R = RowNum To CtrPlat                                                   'Loop to get the Platform assigned to the Mounted equipment group and build out each column in the new_HB_arr
                If PlatSys = CDbl(Split(PlatArr(R, 1), "-")(1)) Then                'if Mounted equip platform_id = platform_id then
                    RowNum = R                                                      'this is so you dont start at the begining of the Platform array. Because of sorting, the data is in chronological order.
                    CtrG = CtrG + 1                                                 'this is to keep track of the row counts (grouped equipment totals)for the new HB array.
                    HBArr(CtrG, 1) = PlatArr(R, 1)                                  'Visio ID which is NodeID-PlatID
                    HBArr(CtrG, 2) = PlatArr(R, 2)                                  '(BN) Unit
                    HBArr(CtrG, 3) = PlatArr(R, 3)                                  '(CO) TOE Title
                    HBArr(CtrG, 4) = PlatArr(R, 4)                                  '(PLT/SEC) Para Desc
                    HBArr(CtrG, 5) = PlatArr(R, 5) & " " & PlatArr(R, 8) & ";;" & PlatArr(R, 9) 'Role Bumper#;;Platform_shading
                    HBArr(CtrG, 6) = PlatArr(R, 7)                                  'Platform_System_type
                    For RowSubEquip = RowEquip To DEquipArr                         'Loop the MEquipArr to get assigned equipment to its row in the new_HB_arr
                        If MEquipArr(RowSubEquip, 7) = PlatSys Then                 'if Node_id's are the same because there are some equipment not linked to a Platform
                            If RowSubEquip < DEquipArr Then
                                If MEquipArr(RowSubEquip + 1, 7) = PlatSys Then
                                    RowLastSub = RowSubEquip + 1
                                    If RowLastSub < DEquipArr Then
                                        While MEquipArr(RowLastSub, 7) = PlatSys And (RowLastSub + 1) < DEquipArr 'gets all of rows in MEquipArr for this Platform
                                            RowLastSub = RowLastSub + 1
                                        Wend
                                        RowLastSub = RowLastSub - 1                 'this is due to the loop goes one over... No Do Until or Do While will not correct this
                                    End If
                                Else: RowLastSub = RowSubEquip                      'sets RowLastSub when there is only one piece of equipment linked to the platform
                                End If
                            Else: RowLastSub = RowSubEquip                          'sets RowLastSub when on the last equipment in the M_equip_list
                            End If
                            For RowSub = RowSubEquip To RowLastSub                  'EquipValue is Name;Network;fill_color;font_color
                                EquipValue = MEquipArr(RowSub, 2) & ";" & MEquipArr(RowSub, 3) & ";" & MEquipArr(RowSub, 5) & ";" & MEquipArr(RowSub, 6) 'Name;Network;fill_color;font_color
                                PlatEquip.Add CDbl(MEquipArr(RowSub, 1)) & ";" & (MEquipArr(RowSub, 4)) & ";" & EquipValue
                            Next RowSub
                            PlatKey = 1                                             'tracks key value needed to remove item from PlatEquip collection
                            Do While PlatEquip.Count <> 0 And PlatKey <= PlatEquip.Count 'this loop puts all equipment WITHOUT a parent_id into the PlatBaseEquip
                                ParID = Split(PlatEquip(PlatKey), ";")
                                If ParID(1) = "" Then                                  'if no parent_id you're a parent
                                    PlatBaseEquip.Add PlatEquip(PlatKey) & ";0"     'add to new list. the ";0" is the indent value for Visio
                                    PlatEquip.Remove (PlatKey)                      'remove from old list
                                Else: PlatKey = PlatKey + 1                         'go to next item in PlatEquip list
                                End If
                            Loop
                            
                            PlatKey = 1
                            Do While PlatEquip.Count <> 0 And PlatKey <= PlatEquip.Count 'this loop puts all equipment WITH a parent_id into the PlatBaseEquip
                                PlatBaseEquipSplit = Split(PlatEquip(PlatKey), ";")
                                ParExists = False
                                PlatBaseEquipKey = 1                                'Key for parents position and reset when looking at a new item from PlatEquip.
                                For Each PlatItem In PlatBaseEquip                      'Loop gets parent's key position from PlatBaseEquip
                                    PlatBaseEquipSplit = Split(BaseItem, ";")
                                    If PlatEquipSplit(1) = PlatBaseEquipSplit(0) Then     'if parent_ID from PlatEquip = unique_id from PlatBaseEquip
                                        ParKey = PlatBaseEquipKey                   'Assigns parents position, but changes for each sibling.
                                        ParExists = True
                                        Exit For
                                    End If
                                    PlatBaseEquipKey = PlatBaseEquipKey + 1
                                Next PlatItem
                                
                                If ParExists = True Then
                                    SubItemKey = 1                                  'Key is for the Sub-equipment loop
                                    For Each BaseItem In PlatEquip                  'loop puts the item and its siblings into Plat_sub_equip collection
                                        SubItemSplit = Split(SubEquipItem, ";")
                                        If PlatEquipSplit(1) = SubItemSplit(1) Then
                                            PlatSubEquip.Add BaseItem               'add to sub list
                                            PlatEquip.Remove (SubItemKey)           'remove from old list
                                            SubItemKey = SubItemKey - 1
                                        End If
                                        SubItemKey = SubItemKey + 1
                                    Next BaseItem
                                    
                                    For Each SubEquipItem In PlatSubEquip
                                        PlatBaseEquip.Add BaseItem & ";" & PlatBaseEquipSplit(6) + 1, after:=ParKey 'add After your parent and siblings. Indent value = your_parent + 1
                                        ParKey = ParKey + 1                         'this adds siblings sequentially
                                    Next SubEquipItem
                                    PlatKey = 1                                     'reset key
                                Else: PlatKey = PlatKey + 1                         'if parent doesn't exist, move to the next item or else move because of a data error
                                End If
                            Loop
                            
                            ColNum = 7                                              'insert PlatBaseEquip to correct cell position of HBArr
                            For Each PlatAlignItem In PlatAlignEquip
                                strVal = Split(PlatAlignItem, ";")                  'Name & Network;fill_color;font_color;indent_value
                                EquipValue = PlatAlignItem(2) & " " & PlatAlignItem(3) & ";" & PlatAlignItem(4) & ";" & PlatAlignItem(5) & ";" & PlatAlignItem(6)
                                HBArr(CtrG, ColNum) = EquipValue
                                ColNum = ColNum + 1
                            Next PlatAlignItem
                            RowSubEquip = RowLastSub                                'Loop counter
                        Else: Exit For
                        End If
                    Next RowSubEquip
                    RowEquip = RowSubEquip                                          'This is so the loop starts back where it left off
                    Exit For
                End If
            Next R
        Next PlatSys
    DoEvents
        Set rST = Nothing
        Set rS = Nothing
        Set HB = Nothing
    End Sub


  2. #2
    ranman256's Avatar
    ranman256 is offline VIP
    Windows Vista Access 2010 32bit
    Join Date
    Apr 2014
    Location
    Kentucky
    Posts
    9,521
    1. you dont need any code.
    2. you don't need arrays (tables are arrays)
    3. you run an append query to add to the target table. You can use functions or lookup tables to convert items to values.

  3. #3
    Thompyt is offline Expert
    Windows 8 Access 2010 32bit
    Join Date
    Sep 2014
    Location
    El Paso, TX
    Posts
    839
    I can set up the table to have the field headings filled and the first 7 field data filled in. The code on the middle would fill in the remaining. I don’t see how not using code would work

  4. #4
    Thompyt is offline Expert
    Windows 8 Access 2010 32bit
    Join Date
    Sep 2014
    Location
    El Paso, TX
    Posts
    839
    I make the table:
    Code:
    Private Sub Set_Up_Table2_Click()
    Dim db As DAO.Database
    Dim C As Integer
    On Error GoTo Error_Handler
    Set db = CurrentDb()
        DoCmd.SetWarnings False ' Alerts don't show
        DoCmd.DeleteObject acTable, "Table2" ' Deletes table if present
    
        ' Adds New Table to dB
     
        db.Execute "CREATE TABLE Table2 ([Visio_ID] Text(25), [E_LIN] Text(25),[BN] Text(120), [CO] Text(95),[PLT_SEC] Text(120),[Role_Bumper] Text(95), [Platform_System] Text(95));"
        
        ' Adds columns - Equip 1 to Equip N to Table2
    C = 1
        For C = C To 40
            DoCmd.RunSQL "ALTER TABLE Table2 Add " & "[Equip_" & C & "] text;"
        Next C
        ' Runs Query to add roles to Table2
        DoCmd.OpenQuery "QryAppendTable2Roles"
    Error_Handler_Exit:
        On Error Resume Next
    Error_Handler:
        If Err.Number = 7874 Then
            Resume Next
        End If
    End Sub
    Fill in the first columns:

    Code:
    INSERT INTO Table2 ( Visio_ID, BN, CO, PLT_SEC, Role_Bumper, Platform_System, E_LIN )
    SELECT IIf([Row Type]="Plat",[Parent Node ID] & "-" & [Platform_ID],[unique_id]) AS Visio_ID, IIf([Unit] Like "No BN TOE - *",Mid([Unit],InStr([Unit],"- ")+2),[Unit]) AS Units, Table1.[TOE Title], Table1.[Para Desc], IIf(IsNull([Role / FE / Node Name]),";",[Role / FE / Node Name]) & IIf(IsNull([Bumper # / Plat ID]) Or [Bumper # / Plat ID]="",";;"," " & [Bumper # / Plat ID] & ";;") AS Role, IIf([Row Type]="FE" Or [Equip HB Name]=".","SOLDIER",IIf([Row Type]="Plat",[Equip HB Name])) AS PlatSys, IIf([Row Type]="PLAT" And [EQUIP HB NAME]<>".",[Equip Lin],IIf([Row Type]="FE","XXB045","TBD")) AS EquipLIN
    FROM Table1
    GROUP BY IIf([Row Type]="Plat",[Parent Node ID] & "-" & [Platform_ID],[unique_id]), IIf([Unit] Like "No BN TOE - *",Mid([Unit],InStr([Unit],"- ")+2),[Unit]), Table1.[TOE Title], Table1.[Para Desc], IIf(IsNull([Role / FE / Node Name]),";",[Role / FE / Node Name]) & IIf(IsNull([Bumper # / Plat ID]) Or [Bumper # / Plat ID]="",";;"," " & [Bumper # / Plat ID] & ";;"), IIf([Row Type]="FE" Or [Equip HB Name]=".","SOLDIER",IIf([Row Type]="Plat",[Equip HB Name])), IIf([Row Type]="PLAT" And [EQUIP HB NAME]<>".",[Equip Lin],IIf([Row Type]="FE","XXB045","TBD"))
    HAVING (((IIf([Row Type]="FE" Or [Equip HB Name]=".","SOLDIER",IIf([Row Type]="Plat",[Equip HB Name])))<>""));
    I would think that the below code is the easiest way to get the: Parent - Children - Grand Children indenting and sequence in the correct manner. The code runs faster than a DCount does.

    Code:
    For Each PlatSys In MntdGrp                                                     'Each Mounted equipment group is a row in the HBArr
        For RC = RowNum To CtrPlat                                                   'Loop to get the Platform assigned to the Mounted equipment group and build out each column in the new_HB_arr
                If PlatSys = CDbl(Split(PlatArr(R, 1), "-")(1)) Then                'if Mounted equip platform_id = platform_id then
                    RowNum = RC                                                      'this is so you dont start at the begining of the Platform array. Because of sorting, the data is in chronological order.
                    CtrG = CtrG + 1                                                 'this is to keep track of the row counts (grouped equipment totals)for the new HB array.
                    HBArr(CtrG, 1) = PlatArr(RC, 1)                                  'Visio ID which is NodeID-PlatID
                    HBArr(CtrG, 2) = PlatArr(RC, 2)                                  '(BN) Unit
                    HBArr(CtrG, 3) = PlatArr(RC, 3)                                  '(CO) TOE Title
                    HBArr(CtrG, 4) = PlatArr(RC, 4)                                  '(PLT/SEC) Para Desc
                    HBArr(CtrG, 5) = PlatArr(RC, 5) & " " & PlatArr(RC, 8) & ";;" & PlatArr(RC, 9) 'Role Bumper#;;Platform_shading
                    HBArr(CtrG, 6) = PlatArr(RC, 7)                                  'Platform_System_type
                    For RowSubEquip = RowEquip To DEquipArr                         'Loop the MEquipArr to get assigned equipment to its row in the new_HB_arr
                        If MEquipArr(RowSubEquip, 7) = PlatSys Then                 'if Node_id's are the same because there are some equipment not linked to a Platform
                            If RowSubEquip < DEquipArr Then
                                If MEquipArr(RowSubEquip + 1, 7) = PlatSys Then
                                    RowLastSub = RowSubEquip + 1
                                    If RowLastSub < DEquipArr Then
                                        While MEquipArr(RowLastSub, 7) = PlatSys And (RowLastSub + 1) < DEquipArr 'gets all of rows in MEquipArr for this Platform
                                            RowLastSub = RowLastSub + 1
                                        Wend
                                        RowLastSub = RowLastSub - 1                 'this is due to the loop goes one over... No Do Until or Do While will not correct this
                                    End If
                                Else: RowLastSub = RowSubEquip                      'sets RowLastSub when there is only one piece of equipment linked to the platform
                                End If
                            Else: RowLastSub = RowSubEquip                          'sets RowLastSub when on the last equipment in the M_equip_list
                            End If
                            For RowSub = RowSubEquip To RowLastSub                  'EquipValue is Name;Network;fill_color;font_color
                                EquipValue = MEquipArr(RowSub, 2) & ";" & MEquipArr(RowSub, 3) & ";" & MEquipArr(RowSub, 5) & ";" & MEquipArr(RowSub, 6) 'Name;Network;fill_color;font_color
                                PlatEquip.Add CDbl(MEquipArr(RowSub, 1)) & ";" & (MEquipArr(RowSub, 4)) & ";" & EquipValue
                            Next RowSub
                            PlatKey = 1                                             'tracks key value needed to remove item from PlatEquip collection
                            Do While PlatEquip.Count <> 0 And PlatKey <= PlatEquip.Count 'this loop puts all equipment WITHOUT a parent_id into the PlatBaseEquip
                                ParID = Split(PlatEquip(PlatKey), ";")
                                If ParID(1) = "" Then                                  'if no parent_id you're a parent
                                    PlatBaseEquip.Add PlatEquip(PlatKey) & ";0"     'add to new list. the ";0" is the indent value for Visio
                                    PlatEquip.Remove (PlatKey)                      'remove from old list
                                Else: PlatKey = PlatKey + 1                         'go to next item in PlatEquip list
                                End If
                            Loop
                            
                            PlatKey = 1
                            Do While PlatEquip.Count <> 0 And PlatKey <= PlatEquip.Count 'this loop puts all equipment WITH a parent_id into the PlatBaseEquip
                                PlatBaseEquipSplit = Split(PlatEquip(PlatKey), ";")
                                ParExists = False
                                PlatBaseEquipKey = 1                                'Key for parents position and reset when looking at a new item from PlatEquip.
                                For Each PlatItem In PlatBaseEquip                      'Loop gets parent's key position from PlatBaseEquip
                                    PlatBaseEquipSplit = Split(BaseItem, ";")
                                    If PlatEquipSplit(1) = PlatBaseEquipSplit(0) Then     'if parent_ID from PlatEquip = unique_id from PlatBaseEquip
                                        ParKey = PlatBaseEquipKey                   'Assigns parents position, but changes for each sibling.
                                        ParExists = True
                                        Exit For
                                    End If
                                    PlatBaseEquipKey = PlatBaseEquipKey + 1
                                Next PlatItem
                                
                                If ParExists = True Then
                                    SubItemKey = 1                                  'Key is for the Sub-equipment loop
                                    For Each BaseItem In PlatEquip                  'loop puts the item and its siblings into Plat_sub_equip collection
                                        SubItemSplit = Split(SubEquipItem, ";")
                                        If PlatEquipSplit(1) = SubItemSplit(1) Then
                                            PlatSubEquip.Add BaseItem               'add to sub list
                                            PlatEquip.Remove (SubItemKey)           'remove from old list
                                            SubItemKey = SubItemKey - 1
                                        End If
                                        SubItemKey = SubItemKey + 1
                                    Next BaseItem
                                    
                                    For Each SubEquipItem In PlatSubEquip
                                        PlatBaseEquip.Add BaseItem & ";" & PlatBaseEquipSplit(6) + 1, after:=ParKey 'add After your parent and siblings. Indent value = your_parent + 1
                                        ParKey = ParKey + 1                         'this adds siblings sequentially
                                    Next SubEquipItem
                                    PlatKey = 1                                     'reset key
                                Else: PlatKey = PlatKey + 1                         'if parent doesn't exist, move to the next item or else move because of a data error
                                End If
                            Loop
                            
                            ColNum = 7                                              'insert PlatBaseEquip to correct cell position of HBArr
                            For Each PlatAlignItem In PlatAlignEquip
                                strVal = Split(PlatAlignItem, ";")                  'Name & Network;fill_color;font_color;indent_value
                                EquipValue = PlatAlignItem(2) & " " & PlatAlignItem(3) & ";" & PlatAlignItem(4) & ";" & PlatAlignItem(5) & ";" & PlatAlignItem(6)
                                HBArr(CtrG, ColNum) = EquipValue
                                ColNum = ColNum + 1
                            Next PlatAlignItem
                            RowSubEquip = RowLastSub                                'Loop counter
                        Else: Exit For
                        End If
                    Next RowSubEquip
                    RowEquip = RowSubEquip                                          'This is so the loop starts back where it left off
                    Exit For
                End If
            Next RC
        Next PlatSys

    Thus I am trying to write the attached data to the table2 unfilled columns in the correct sequence.


    Thanks for the assistance.

Please reply to this thread with any new information or opinions.

Similar Threads

  1. Replies: 4
    Last Post: 01-15-2019, 11:50 AM
  2. Replies: 1
    Last Post: 03-06-2017, 06:48 AM
  3. Replies: 2
    Last Post: 06-30-2016, 06:38 PM
  4. Replies: 2
    Last Post: 04-15-2014, 01:59 PM
  5. COUNT Group Count Records COUNT FUNCTION
    By PMCOFFEY in forum Access
    Replies: 9
    Last Post: 11-09-2012, 09:40 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
Other Forums: Microsoft Office Forums