Line through selected cells

[rjplante]

I would like to draw a diagonal line from the lower left corner to the upper right corner of a selected group of cells. I am not talking about a diagonal line through all the cells in my selection, I am talking about a line drawn across the entire selection. The user may select range("A25:E32) and I want the line to run from cell A32 to cell E25. The next time it may be range("A54:E56"). Is it possible to do this using VBA?

Thanks for the ideas.

 

[Caleeco]

My first thought was to do this using Excel Borders, however, the range you suggested is of unequal size (different number of rows and columns).

So that leaves 2 options

1. You merge the cells (I can't tell if this is acceptable without knowing the use-case)
2. You use VBA to draw a line (shape object) on the sheet. But if you resize cells, this may become a mess.

What the reason for selecting and needing to create the diagonal line?

Caleeco

 

[rjplante]

Thanks for the suggestions. I like the merge cells option as it might be the easiest for what I need to do.

 

[Caleeco]

Ah ok cool. If Merging cells is acceptable, the solution below should work:

Sub Merge_and_Border()
'---/ Purpose: To merge selected cells and add a diagonal border
    With Selection
        .Merge
        '.Borders(xlDiagonalDown).LineStyle = xlContinuous
        .Borders(xlDiagonalUp).LineStyle = xlContinuous
    End With
End Sub

I've included code for diagonal up/down, depending on which one you want.

Hope that helps
Caleeco

 

[Norie]

This will draw a line from the top left of the top left cell of the selected range to the bottom right of the bottom right cell of the selected range.

Sub DrawLine()
Dim rng As Range
Dim rngBtmRight As Range
Dim rngTopLeft As Range
Dim line As Shape

    Set rng = Selection
    
    With rng
        Set rngBtmRight = .Cells(.Rows.Count + 1, .Columns.Count + 1)
        Set rngTopLeft = .Cells(1, 1)
    End With
    
    rng.Parent.Shapes.AddConnector msoConnectorStraight, rngTopLeft.Left, rngTopLeft.Top, _
                                                        rngBtmRight.Left, rngBtmRight.Top
End Sub

 

[rjplante]

This will draw a line from the top left of the top left cell of the selected range to the bottom right of the bottom right cell of the selected range.

Sub DrawLine()
Dim rng As Range
Dim rngBtmRight As Range
Dim rngTopLeft As Range
Dim line As Shape

    Set rng = Selection
   
    With rng
        Set rngBtmRight = .Cells(.Rows.Count + 1, .Columns.Count + 1)
        Set rngTopLeft = .Cells(1, 1)
    End With
   
    rng.Parent.Shapes.AddConnector msoConnectorStraight, rngTopLeft.Left, rngTopLeft.Top, _
                                                        rngBtmRight.Left, rngBtmRight.Top
End Sub

Norie,

You code works awesome, but I need the line to run up from the lower left to the upper right. Your code draws the line from the upper left to the lower right. How do I modify the code to accomplish this.

 

[rjplante]

This will draw a line from the top left of the top left cell of the selected range to the bottom right of the bottom right cell of the selected range.

Sub DrawLine()
Dim rng As Range
Dim rngBtmRight As Range
Dim rngTopLeft As Range
Dim line As Shape

    Set rng = Selection
   
    With rng
        Set rngBtmRight = .Cells(.Rows.Count + 1, .Columns.Count + 1)
        Set rngTopLeft = .Cells(1, 1)
    End With
   
    rng.Parent.Shapes.AddConnector msoConnectorStraight, rngTopLeft.Left, rngTopLeft.Top, _
                                                        rngBtmRight.Left, rngBtmRight.Top
End Sub

Norie,

I figured out how to change the line direction, now how do I change the line color form blue to black?

Thanks!