length of line depending on the value of the cell

[Subodh]

Hi All,
I want to get / draw a line in a row of cell, lets say from in
Row1.
And, if the value in A1 is 1 the line should be in Cell B1
if 2 the the line should be in
cell b1,c1
if 3 the line should be in cell
b1,c1,d1 and so on.
The line always has to be horizontal.

 

[Vacuum Sealed]

You could try this:

Place this behind your Sheet, it will update evrytime the value changes.

You will have to enter however many additional arguments you want based on
how many lines across the sheet you want to go.

HTH
Mick.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1")) Is Nothing Then
Select Case True
Case Target.Value = 1
Rows("1:1").Borders(xlEdgeBottom).LineStyle = xlNone
With Range("B1:C1").Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Case Target.Value = 2
Rows("1:1").Borders(xlEdgeBottom).LineStyle = xlNone
With Range("B11").Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
End Select
End If
End Sub

 

[Don Guillett]

You could try this:

Place this behind your Sheet, it will update evrytime the value changes.

You will have to enter however many additional arguments you want based on
how many lines across the sheet you want to go.

HTH
Mick.

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("A1")) Is Nothing Then
        Select Case True
            Case Target.Value = 1
                Rows("1:1").Borders(xlEdgeBottom).LineStyle = xlNone
                With Range("B1:C1").Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
                End With
            Case Target.Value = 2
                Rows("1:1").Borders(xlEdgeBottom).LineStyle = xlNone
                With Range("B11").Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
                End With
        End Select
 End If
End Sub

IF? that is what is needed then try this for any number in a1
Right click sheet tab>view code>insert this

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub
Rows(1).Borders(xlEdgeBottom).LineStyle = xlNone
Range(Cells(1, 1), Cells(1, Target)) _
..Borders(xlEdgeBottom).LineStyle = xlContinuous
End Sub

 

[Don Guillett]

You could try this:

Place this behind your Sheet, it will update evrytime the value changes.

You will have to enter however many additional arguments you want based on
how many lines across the sheet you want to go.

HTH
Mick.

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("A1")) Is Nothing Then
        Select Case True
            Case Target.Value = 1
                Rows("1:1").Borders(xlEdgeBottom).LineStyle = xlNone
                With Range("B1:C1").Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
                End With
            Case Target.Value = 2
                Rows("1:1").Borders(xlEdgeBottom).LineStyle = xlNone
                With Range("B11").Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
                End With
        End Select
 End If
End Sub

RE sending
Right click sheet tab>view code>insert this

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub
Rows(1).Borders(xlEdgeBottom).LineStyle = xlNone
Range(Cells(1, 1), Cells(1, Target)) _
..Borders(xlEdgeBottom).LineStyle = xlContinuous
End Sub

 

[Vacuum Sealed]

Hey Don

Very nice, neat code, although the OP requirement was if A1 has the value of
1 then B1 will have a line.

Your code places a line under A1 when the value is 1 instead of B1.

Cheers
Mick.

 

[GS]

Mick,
Why not...

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
If Not Intersect(Target, Range("A1")) Is Nothing Then
Select Case Target.Value
Case Is = 1: Set rng = Range("B1:C1")
Case Is = 2: Set rng = Range("B11")
End Select 'Case Target.Value
Rows("1:1").Borders(xlEdgeBottom).LineStyle = xlNone
With rng.Borders(xlEdgeBottom)
.LineStyle = xlContinuous: .Weight = xlThin
.ColorIndex = 0: .TintAndShade = 0
End With
Set rng = Nothing
End If
End Sub