Auto create line from earliest to latest date in range

[Corleone]

is there a way of getting excel to automatically generate a line that spans from the earliest date to the latest date - (see attached)
I suspect this one might be a bridge to far

I am currently using the formula in the gannt chart area with the characters set up in the conditioning formating
=FILTER(CHAR({186,190,191,192,187}),(G$2<=$B4:$F4)*(G$2>$B4:$F4-($H$2-$G$2)),"")

however im having to put the line in manually

any ideas appreciated
Thanks

 

[davesexcel]

You can use two helper columns that will locate the start and end dates, then use code to draw the lines.

Sub MakeLines()
    Dim sh As Worksheet
    Dim rng As Range, c As Range
    Dim m As Date, n As Date
    Dim mx As Range, nx As Range
    Dim dRng As Range
    Dim col As Long
    Dim LRng As Range
    Dim L, T, W, H
    Dim shp As Shape

    Set sh = ActiveSheet

    With sh
        For Each shp In .Shapes
            On Error Resume Next
            If shp.Name Like "*Line*" Then
                shp.Delete
            End If
            On Error GoTo 0
        Next
        col = .Cells(2, .Columns.Count).End(xlToLeft).Column
        Set dRng = .Range(.Cells(2, "G"), .Cells(2, col))
        Set rng = .Range("A4:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)
        For Each c In rng.Cells
            m = c.Offset(, 1).Value
            n = c.Offset(, 2).Value
            Set mx = dRng.Find(DateValue(m), LookIn:=xlFormulas, LookAt:=xlPart)
            Set nx = dRng.Find(DateValue(n), LookIn:=xlFormulas, LookAt:=xlPart)
            Set LRng = .Range(.Cells(c.Row, mx.Column), .Cells(c.Row, nx.Column))
            'LRng.Select
            With LRng
                L = .Left
                T = .Top
                W = .Width
                H = .Height
            End With
           
            Set shp = .Shapes.AddConnector(msoConnectorStraight, L, _
                                           T + H / 2, L + W, T + H / 2)
            With shp
                .Name = "Line " & c.Row
            End With
        Next


    End With

End Sub

See attached sample, download to excel
Hide column B & C so nobody sees it.

CorleoneWB.xlsm

Sheet1 8,9,10,11,12,13,14,15,16,17,18,19,20 Start,5/9/2022,19/9/2022,3/10/2022,17/10/2022,31/10/2022,14/11/2022,28/11/2022,12/12/2022,26/12/2022,9/1/2023,23/1/2023,6/2/2023 Min Date,Max Date Test 1,19/9/2022,5/8/2024,9/10/2022,1/10/2022,22/7/2024,12/8/2024,28/10/2023 Test2,6/2/2023,28/10/2024,6/...

docs.google.com

 

[Corleone]

Cheers - Ill give this a go on Monday and report back

 

[Corleone]

You can use two helper columns that will locate the start and end dates, then use code to draw the lines.

View attachment 73151

Sub MakeLines()
    Dim sh As Worksheet
    Dim rng As Range, c As Range
    Dim m As Date, n As Date
    Dim mx As Range, nx As Range
    Dim dRng As Range
    Dim col As Long
    Dim LRng As Range
    Dim L, T, W, H
    Dim shp As Shape

    Set sh = ActiveSheet

    With sh
        For Each shp In .Shapes
            On Error Resume Next
            If shp.Name Like "*Line*" Then
                shp.Delete
            End If
            On Error GoTo 0
        Next
        col = .Cells(2, .Columns.Count).End(xlToLeft).Column
        Set dRng = .Range(.Cells(2, "G"), .Cells(2, col))
        Set rng = .Range("A4:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)
        For Each c In rng.Cells
            m = c.Offset(, 1).Value
            n = c.Offset(, 2).Value
            Set mx = dRng.Find(DateValue(m), LookIn:=xlFormulas, LookAt:=xlPart)
            Set nx = dRng.Find(DateValue(n), LookIn:=xlFormulas, LookAt:=xlPart)
            Set LRng = .Range(.Cells(c.Row, mx.Column), .Cells(c.Row, nx.Column))
            'LRng.Select
            With LRng
                L = .Left
                T = .Top
                W = .Width
                H = .Height
            End With
          
            Set shp = .Shapes.AddConnector(msoConnectorStraight, L, _
                                           T + H / 2, L + W, T + H / 2)
            With shp
                .Name = "Line " & c.Row
            End With
        Next


    End With

End Sub

See attached sample, download to excel
Hide column B & C so nobody sees it.

CorleoneWB.xlsm

Sheet1 8,9,10,11,12,13,14,15,16,17,18,19,20 Start,5/9/2022,19/9/2022,3/10/2022,17/10/2022,31/10/2022,14/11/2022,28/11/2022,12/12/2022,26/12/2022,9/1/2023,23/1/2023,6/2/2023 Min Date,Max Date Test 1,19/9/2022,5/8/2024,9/10/2022,1/10/2022,22/7/2024,12/8/2024,28/10/2023 Test2,6/2/2023,28/10/2024,6/...

docs.google.com

Hi - I just had a quick look at it - The formulas work fine
but when i run the macro i fails at the following line
Set LRng = .Range(.Cells(c.Row, mx.Column), .Cells(c.Row, nx.Column))

I tried changing "Set rng = .Range("A4:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)" to A5 as this is the row where the dates begin but it still falls down at the line above

Cheers

 

[davesexcel]

If it works with the sample I gave you but does not work with your sample. Then you would have to supply a sample to look at.