title: Powerpoint layout algorithm for box-in-box view
body: <p>I am trying to write some code in VBA and PowerPoint to automatically create a poster (basically a box in box view)  however, its proving to be a little more challenging than my skills can cope.</p>
  <p>looking to get some guidance on how best to structure the code (and patterns)
  at the moment:</p>
  <ul>
  <li>Im reading the data (see table) from csv, and placing them into 4 in memory arrays (cat, sub-cat, column, intersection) - this is probably bad - but dont know of anything better.</li>
  <li>my code tries to process the spacing logic and adjusts the x-and-y pos of each intersection block (grows the category and sub-category blocks when needed) within the arrays, then finally draws/places the blocks on the powerpoint canvas.</li>
  <li>You will see in the graphic &quot;initial selected block&quot; at the moment thats the context from which i run -- the idea is to use that block size as the template for the dimensions</li>
  </ul>
  <p>Im not worried about the placement, its more the algorithm to determine the spacing (or block size of each of the components</p>
  <p>below is a sample of the data that I read:
  <a href="https://i.stack.imgur.com/6jimo.png" rel="nofollow noreferrer"><img src="https://i.stack.imgur.com/6jimo.png" alt="enter image description here" /></a></p>
  <p>and once the logic is generated, this is how the &quot;poster&quot; would look
  <a href="https://i.stack.imgur.com/6bCP4.png" rel="nofollow noreferrer"><img src="https://i.stack.imgur.com/6bCP4.png" alt="enter image description here" /></a></p>
  <p>Im happy to share code, its just getting a bit big now (and I feel im missing a trick in terms of simplicity)</p>
  <p>code sample included below:</p>
  <pre><code>Const defaultObjectWidth = 95
  Const defaultObjectHeight = 50
  Const defaultCategoryWidth = 90
  Const defaultSubCatWidth = 90
  Const defaultBuffer = 3
  Const blocksPerCol = 4
  Const myYAxisWidth = 100
  
  Sub insertShape()
  On Error GoTo Err_Handler
    Dim SlideHeight As Long, SlideWidth As Long
    Dim ContainerHeight As Long, ContainerWidth As Long
    Dim ObjectHeight As Long, ObjectWidth As Long
    Dim x As Long, y As Long
    Dim shp As Object
    Dim colWidth As Integer
    Dim blockSize As Integer
    Dim IntersectCalcComplete As Boolean
    
    IntersectCalcComplete = False
    
    ' create the Arrays for storing the data
    Dim CategorysArr()  As String
    Dim SubCatsArr()  As String
    Dim YAxissArr() As String
    Dim IntersectsArr() As String
    Dim tmpIntersects() As String
  
    
  Call LoadSubCats(SubCatsArr)
  Call LoadCategorys(CategorysArr)
  Call LoadYAxiss(YAxissArr)
  Call LoadIntersects(IntersectsArr)
      
    
  ReDim tmpIntersects(0 To 2, 0 To 0)
    
    If ActiveWindow.Selection.Type = ppSelectionNone Then
      MsgBox &quot;Please select object&quot;, vbExclamation, &quot;Make Selection&quot;
    Else
      Set shp = ActiveWindow.Selection.ShapeRange(1)
      
      SlideHeight = ActivePresentation.PageSetup.SlideHeight 'get slide vertical height
      SlideWidth = ActivePresentation.PageSetup.SlideWidth  'get slide horizontal width
      'Main Content Container width and height
      ContainerHeight = shp.Height
      ContainerWidth = shp.Width
      
      
      ' calculate the container column sizes.
      '
      colWidth = calcColumnSizes(shp.Width, CategorysArr, SubCatsArr, YAxissArr)
      ' calculate the blockwidth based on the density factor parameter
      blockWidth = calcBlockWidth(colWidth, blocksPerCol)
      
      ' Iterate through the Categorys, SubCats and Intersects in order to calculate the spacing of the Intersects.
      
               ' first sort the matricies by a specific column.
               ' CategorysArr = QuickSortArray(CategorysArr, -1, -1, 4)
               ' Call multiSortArray(1, CategorysArr, arrFlds(CategorysArr), &quot;2 Asc 5 Asc&quot;)
     ' -- ------------------------------------------------------------------------------------------------------------------------------------------------
      Dim SubCatID As Integer
      'Dim myYAxisWidth As Integer
      Dim SubCatHeight, CategoryHeight, currentX, currentY, n, t As Integer
      
      SubCatHeight = 0
      CategoryHeight = 0
      currentX = 0
      currentY = 0
      currentBlockUsed = 0
      
      For i = LBound(SubCatsArr, 2) To UBound(SubCatsArr, 2) ' For each SubCat in the SubCats Array
      
      t = t + 1
      'Debug.Print (&quot; processing SubCat: &quot; &amp; t &amp; &quot; called: &quot; &amp; SubCatsArr(1, i))
      
         ' Debug.Print (SubCatsArr(i, 1)) ' print the name
          SubCatID = SubCatsArr(0, i)
          If Not IsNull(SubCatID) Then
              ' with each SubCat - find all related Intersects and fit them into the canvas
              
              ' 1: Filter the Intersects by SubCat
              Call getIntersectBySubCat(SubCatID, IntersectsArr, tmpIntersects)
              'printArray (tmpIntersects)
              ' 2: re-structure the Intersects position to fit into the YAxiss allocated
            '  myYAxisWidth = 200  ' -- get YAxis width TODO: get the real width
                                 ' -- we already know what the blockWidth is (above)
               SubCatHeight = defaultObjectHeight + defaultBuffer  ' set the SubCatheight on the first pass.
              For j = LBound(tmpIntersects, 2) To UBound(tmpIntersects, 2)  ' Loop through tmp Intersects to add placement
             
              
              If LBound(tmpIntersects, 2) = -1 Then   ' SubCat has no Intersects
              ' Debug.Print (&quot;SubCat ID:&quot; &amp; SubCatID &amp; &quot; has no Intersects&quot;)
              
              
              Else
                  If myYAxisWidth &lt; (currentX + blockWidth + (defaultBuffer * 2)) Then  ' If there is not enough remaining space in YAxis
                      currentY = currentY + defaultBuffer + defaultObjectHeight
                      currentX = 0
                      SubCatHeight = SubCatHeight + defaultObjectHeight + defaultBuffer
                  End If
                  n = findArrStr(IntersectsArr, 0, str(tmpIntersects(0, j)))
                  IntersectsArr(6, n) = str(currentX + defaultBuffer)  ' X CoOrdinate
                  IntersectsArr(7, n) = str(currentY + defaultBuffer)  ' Y CoOrdinate
              
                  currentX = currentX + defaultBuffer + defaultObjectWidth
              
              End If
              
              
              Next j 'filtered Intersect
          Else
        '  Debug.Print (&quot;empty record in Array Detected&quot;)
          End If
          
           Call setSubCatHeight(SubCatHeight, SubCatID, SubCatsArr, CategorysArr)
          SubCatHeight = 0
          
          
      Next i 'SubCat
      
      
      
      
  ' -- -------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
  ' -- -------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
     ' ADDING OF THE SHAPES TO THE VIEW
     
     Call addCategorys(CategorysArr, shp)
     Call addSubCats(SubCatsArr, shp)
     Call addIntersects(IntersectsArr, shp)
      
      
     ' x = (SlideWidth - ObjectWidth) / 2 'calculate horizontal position
     ' y = (SlideHeight - ObjectHeight) / 2 'calculate vertical position
     ' shp.Left = x 'move object horizontal
     ' shp.Top = y 'move object vertical
    End If
    
  Exit_Label:
    On Error Resume Next
    Set shp = Nothing
    Exit Sub
  Err_Handler:
    MsgBox Err.Description, vbCritical
      Resume Exit_Label
  
  End Sub
  Function getIntersectBySubCat(SubCatID As Integer, ByRef IntersectsArr As Variant, ByRef tmpIntersects As Variant)
  ' Filters the Intersects to the specific SubCat
   Dim i, j As Integer
   j = -1
  
   Erase tmpIntersects
   ReDim Preserve tmpIntersects(0 To 2, -1 To 0)
   
   For i = LBound(IntersectsArr, 2) To UBound(IntersectsArr, 2)
      If IntersectsArr(2, i) = SubCatID Then  'if the Intersect relates to the current SubCat
          j = j + 1
          ReDim Preserve tmpIntersects(0 To 2, 0 To j)  ' Redimension:
   
          tmpIntersects(0, j) = IntersectsArr(0, i)  ' Intersect Code
          tmpIntersects(1, j) = IntersectsArr(3, i) ' get the YAxis
          tmpIntersects(2, j) = IntersectsArr(9, i) ' get the Order
          
          
          
          'Debug.Print (&quot;RESULT ARRAY&quot; &amp; tmpIntersects(i + 1, 0) &amp; &quot;_&quot; &amp; tmpIntersects(i + 1, 1) &amp; &quot;_&quot; &amp; tmpIntersects(i + 1, 2) &amp; &quot;_&quot;)
      End If
   
   Next i 'Intersect
      
      ' sort the array by the Intersect order column (2)
     ' Call QuickSortArray(tmpIntersects, , , 2)
  
  
  
  End Function
  
  Function calcColumnSizes(lenContainer As Integer, ByRef CategorysArr As Variant, ByRef SubCatsArr As Variant, ByRef YAxissArr As Variant) As Integer
  Dim lenCategory, lenSubCat, cntQtr As Integer
  Dim lenWorkArea, columnSize As Integer
  
  
  cntQtr = UBound(YAxissArr) + 1
  
  lenWorkArea = lenContainer - defaultCategoryWidth - defaultSubCatWidth - (2 * defaultBuffer)
  lenWorkArea = lenWorkArea - ((2 * defaultBuffer) + (cntQtr * defaultBuffer))
  columnSize = lenWorkArea / cntQtr
  
  ' now propogate the columnSize into the YAxiss data
      For i = LBound(YAxissArr, 1) To UBound(YAxissArr, 1)
          YAxissArr(2, i) = str(Round(columnSize, 1)) ' Width
      Next i
   calcColumnSizes = columnSize
  
  End Function
  
  Function calcBlockWidth(columnSize As Integer, density As Integer) As Integer
      calcBlockWidth = columnSize / density
  
  End Function
  
  Function setSubCatHeight(SubCatYPos, ID As Integer, ByRef SubCatsArr As Variant, ByRef CategorysArr As Variant)
  Dim curSubCat As Integer
      curSubCat = findArrStr(SubCatsArr, 0, str(ID))
      If SubCatsArr(3, curSubCat) &lt; SubCatYPos Then
          SubCatsArr(3, curSubCat) = SubCatYPos
         Call setCategoryHeight(SubCatYPos, CInt(SubCatsArr(2, curSubCat)), CategorysArr)
      End If
  
  
  End Function
  Function setCategoryHeight(CategoryYPos, ID As Integer, ByRef CategorysArr As Variant)
  Dim curCategory As Integer
      curCategory = findArrStr(CategorysArr, 0, str(ID))
      If CategorysArr(2, curCategory) &lt; CategoryYPos Then
          CategorysArr(2, curCategory) = CategoryYPos
      End If
  End Function
  Function addCategorys(ByRef CategorysArr As Variant, masterShp As Shape)
  
  Dim i, j As Integer
  
  For i = LBound(CategorysArr, 2) To UBound(CategorysArr, 2)
      Call addBlockContents(CInt(CategorysArr(2, i)), CInt(CategorysArr(3, i)), CStr(CategorysArr(1, i)), masterShp)  ' X, Y, Name, Shape
  Next i
      
  End Function
  Function addSubCats(ByRef SubCatsArr As Variant, masterShp As Shape)
  
  Dim i, j As Integer
  
  For i = LBound(SubCatsArr, 2) To UBound(SubCatsArr, 2)
      Call addBlockContents(CInt(SubCatsArr(3, i)), CInt(SubCatsArr(4, i)), CStr(SubCatsArr(1, i)), masterShp)
  Next i
      
  End Function
  
  
  Function addIntersects(ByRef IntersectsArr As Variant, masterShp As Shape)
  
  Dim i, j As Integer
  Dim myX, myY As Integer
  myX = 0
  myY = 0
  For i = LBound(IntersectsArr, 2) To UBound(IntersectsArr, 2)
  
  ' adjust the placement of the shape relative to the masterShape
  myX = masterShp.Left + CInt(IntersectsArr(6, i)) + defaultCategoryWidth + defaultSubCatWidth + (defaultBuffer * 2)
  myY = masterShp.Top + CInt(IntersectsArr(7, i))
  Call addBlockContents(myX, myY, CStr(IntersectsArr(1, i)), masterShp)
  
  
  
           'For j = LBound(COAArray, 2) To UBound(COAArray, 2)
           'Next j
       Next i
      
  End Function
  
  
  Function addBlockContents(x, y, IntersectName As String, myShp As Shape)
  Dim oSh As Shape
  
  Set oSh = ActiveWindow.Selection.SlideRange.Shapes.AddShape(msoShapeRectangle, x, y, defaultObjectWidth, defaultObjectHeight)
      With oSh
       With .Fill
          .Visible = msoTrue
          .ForeColor.ObjectThemeColor = msoThemeColorText2
          .ForeColor.TintAndShade = 0
          .ForeColor.Brightness = 0.8000000119
          .Transparency = 0
          .Solid
      End With 'fill
        With .TextFrame
          .MarginLeft = 0
          .MarginRight = 0
          .MarginTop = 0
          .MarginBottom = 0
          .AutoSize = False
          
         With .TextRange
            .Text = IntersectName
             With .Font
              .Name = &quot;Ariel&quot;
              .Size = 6.4
              .Bold = msoFalse
              .Italic = msoFalse
              .Underline = msoFalse
              .Shadow = msoFalse
              .Emboss = msoFalse
              .BaselineOffset = 0
              .AutoRotateNumbers = msoFalse
              .Color.SchemeColor = ppForeground
          End With   ' Font
         End With   ' TextRange
         End With   ' TextFrame
  End With   ' oSh, the shape itself
  'Set addBlockContents = oSh
  End Function
  </code></pre>
  <p>any help will be awesome!</p>