Need help to move the point of two lines created by VBA

[Tirrazo]

Hi,

Is it possible to edit this code so that the lines will meet each other on the left side, not the right side?

Is it also possible to make a code for just the bottom line?


Regards

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error Resume Next
    If Not Intersect(Target, Range("A1:CF300")) Is Nothing Then ' < this is the range where you want the lines to be
        With ActiveSheet.Shapes("Down Arrow 1")
            .Visible = True ' make the line visible
            .Left = Target.Left + Target.Width
            .Top = 0 ' very top of worksheet
            .Width = 3 ' width of line
            .Height = Rows("1:" & Target.Row).Height
        End With
        With ActiveSheet.Shapes("Right Arrow 1")
            .Visible = True ' make the line visible
            .Left = 0 ' very left of worksheet
            .Top = Target.Top + Target.Height
            .Width = Range(Cells(Target.Row, 1), Cells(Target.Row, Target.Column)).Width
            .Height = 3 ' width of the line
        End With
    Else
        ActiveSheet.Shapes("Down Arrow 1").Visible = False ' hide the lines if out of range
        ActiveSheet.Shapes("Right Arrow 1").Visible = False ' hide the lines if out of range
    End If
    On Error GoTo 0
End Sub

 

[Fluff]

How about

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error Resume Next
    If Not Intersect(Target, Range("A1:CF300")) Is Nothing Then ' < this is the range where you want the lines to be
        With ActiveSheet.Shapes("Down Arrow 1")
            .Visible = True ' make the line visible
            .Left = Target.Left
            .Top = 0 ' very top of worksheet
            .Width = 3 ' width of line
            .Height = Rows("1:" & Target.Row).Height
        End With
        With ActiveSheet.Shapes("Right Arrow 1")
            .Visible = True ' make the line visible
            .Left = 0 ' very left of worksheet
            .Top = Target.Top + Target.Height
            .Width = Range(Cells(Target.Row, 1), Cells(Target.Row, Target.Column - 1)).Width
            .Height = 3 ' width of the line
        End With
    Else
        ActiveSheet.Shapes("Down Arrow 1").Visible = False ' hide the lines if out of range
        ActiveSheet.Shapes("Right Arrow 1").Visible = False ' hide the lines if out of range
    End If
    On Error GoTo 0
End Sub

 

[Tirrazo]

Thank you!

This is working very well!

Is it possible to extend the horizontal line beyond the marked cell x cells to the right from the cell you are standing on?

 

[Fluff]

Yes, just change the -1 to + whatever you want.

 

[Tirrazo]

This is working, but now there is another issue.

As the horizontal line is passing beyond the cell, I can't drag the cell because the line lies above.

Is there any solution to this or is the solution to put the line on top of the cell instead of under?

 

[Fluff]

You could shift it up a bit like

            .Top = Target.Top + Target.Height / 2

 

[Tirrazo]

That is working to.

What number do you divide with to get the line on top of the cell?

 

[Fluff]

Try

.Top = Target.Top