VBA/Excel challenge

Associate
Joined
7 Nov 2010
Posts
87
Location
Cambridge, UK
I've got a problem I've been working on for quite a long while, and I've been trying to write something like the following asking for help for about as long :) It's difficult for me to explain. So if you'r good with VBA and patient enough to read what I've done below I'd really appreciate any help you can give :)

In my worksheet there are several sets of ranges.

Each one of these ranges is 1 Column wide and a dynamic number of Rows.

The ranges have nothing to do with each other (so its values are only relevant to itself)

Each range has a unique number, and the values of the range are Group Names.

There can (will) be multiple instances of a group name, and there is no limit to the number of groups that can be in a range.

Each cell in the range will either have a group name or be Empty

I have a function that reads through the source sheet and copies relevant data into a new sheet (called Groupings).

The new sheet has 3 columns, Range Number, Group Name, and Cell Address.

-Range number is the unique number of the range
-Group name is the value from the range
-Cell Address is the address of the cell inside the range.

An example of the Groupings sheet:
1 G1 $A$1
1 G2 $A$2
1 G1 $A$3
1 G1 $A$4
1 G2 $A$5

I need a function that will draw a line connecting each group name togeather (like in the picture)

example.png


Drawing the line is not the main issue (as I have a function that can do this already)

What I cant figure out how to do is make the function draw the lines in available space, instead of just moving further across.

Looking at the picture, you can see that the TW2 Group's line could fit in the first column without collision, and then TW3's line could move across into its place.

Can anyone think of a way to accomplish this?

I can provide examples of the code I have, but its not exactly pretty.
 
If anyone is interested here's what I've come up with. (it doesn't draw anything yet, just works out the positioning)

Code:
Public Sub updateTwists()
Dim Sheet As Worksheet
Dim Item As Range
Dim Group As Range
Dim Key As Variant
Dim Groups As Dictionary
Dim GroupItem() As Variant
Dim GroupItem1() As Variant
Dim Row As Integer
Dim Offset As Integer
Dim Complete As Boolean
Dim Start As Integer
Dim Finish As Integer
Dim Search As Boolean
Dim Test As Integer
Dim Depth As Integer
Dim Index As Integer
Dim Skip As Boolean
Dim Available() As Boolean ' note: false = Available, true = Unavailable - as undefined evaulates to false
Row = 1
Offset = 0
Complete = False

Set Sheet = ThisWorkbook.Worksheets("Group")

' Group Sheet Columns
' >Connector Number
' >Group Name
' >Cell Column
' >Cell Row
' Data must be sorted, Low->High on all columns.

While Complete = False

    Set Groups = New Dictionary

    Set Item = Sheet.Cells(Row, 1)
    
    ' populate the Groups Dictionary
    ' Group = Array ( First Item, Last Item, Depth, All Items )
    Do While Sheet.Cells(Row + Offset, 1).Value = Item.Value
        If Groups.Exists(Sheet.Cells(Row + Offset, 2).Value) = False Then
            Groups.Add Sheet.Cells(Row + Offset, 2).Value, Array(Sheet.Cells(Row + Offset, 4).Value, Sheet.Cells(Row + Offset, 4).Value, 0, "$" & Sheet.Cells(Row + Offset, 3) & "$" & Sheet.Cells(Row + Offset, 4))
Debug.Print "Added [" & Sheet.Cells(Row + Offset, 2).Value & "]"
        Else
            GroupItem = Groups.Item(Sheet.Cells(Row + Offset, 2).Value)
            GroupItem(1) = Sheet.Cells(Row + Offset, 4).Value
            GroupItem(3) = GroupItem(3) & ",$" & Sheet.Cells(Row + Offset, 3) & "$" & Sheet.Cells(Row + Offset, 4)
            Groups.Item(Sheet.Cells(Row + Offset, 2).Value) = GroupItem
            
Debug.Print "Updated [" & Sheet.Cells(Row + Offset, 2).Value & "] - " & GroupItem(0) & ", " & GroupItem(1)
        End If
        Offset = Offset + 1
    Loop
    
    ' used to log available cells in the range
    ReDim Available(Row To (Row + Offset), 0 To 100)
    
    For Each Key In Groups.Keys()
        GroupItem = Groups.Item(Key)
        Search = True
        Skip = False
        Do While Search = True
            Depth = 0
            ' search for an empty slot
            For Test = GroupItem(0) To GroupItem(1)
                If Skip = False Then
                    If Available(Test, Depth) = True Then
                        Depth = Depth + 1
                        Skip = True
                    End If
                End If
            Next Test
            ' reserve the slot once found and update depth
            For Test = GroupItem(0) To GroupItem(1)
                Available(Test, Depth) = True
                GroupItem1 = Groups.Item(Key)
                GroupItem1(2) = Depth
                Groups.Item(Key) = GroupItem1
                Search = False
            Next Test
        Loop
    Next Key

    For Each Key In Groups.Keys()
        GroupItem = Groups.Item(Key)
Debug.Print Key & ": First=" & GroupItem(0) & ", Last=" & GroupItem(1) & ", Depth=" & GroupItem(2) & ", Pins=" & GroupItem(3)
    Next Key
    
    
    Set Group = Range(Sheet.Cells(Row, 3), Sheet.Cells(Row + Offset - 1, 3))
    
    Row = Row + Offset

    If Sheet.Cells(Row, 1) = Empty Then
        Complete = True
    End If
Wend

End Sub
 
Last edited:
Back
Top Bottom