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

 

[Don Guillett]

Hey Don

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

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

Cheers
Mick.

Simple change
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, 2), Cells(1, Target + 1)) _
..Borders(xlEdgeBottom).LineStyle = xlContinuous
End Sub

 

[Don Guillett]

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

--
Garry

Free usenet access athttp://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc

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, 2), Cells(1, Target + 1)) _
..Borders(xlEdgeBottom).LineStyle = xlContinuous
End Sub

 

[GS]

Don Guillett submitted this idea :

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, 2), Cells(1, Target + 1)) _
.Borders(xlEdgeBottom).LineStyle = xlContinuous
End Sub

Don,
Your suggestion is NOT addressing the result the OP wants! Also, it's
not as self-documenting for the less skilled programmer.

Range(Cells(1, 2), Cells(1, Target + 1))
is the same as...
Range("B1", "B1")
...because Target must be "A1" for the code to execute.

The result range being changed is conditional on what's entered in A1.
How does your suggestion accomplish this?

 

[Don Guillett]

Don Guillett submitted this idea :







Don,
Your suggestion is NOT addressing the result the OP wants! Also, it's
not as self-documenting for the less skilled programmer.

  Range(Cells(1, 2), Cells(1, Target + 1))
is the same as...
  Range("B1", "B1")
..because Target must be "A1" for the code to execute.

The result range being changed is conditional on what's entered in A1.
How does your suggestion accomplish this?

--
Garry

Free usenet access athttp://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc- Hide quoted text -

- Show quoted text -

Perhaps you would benefit from a RE read of the OP desires (as I did)
and a test of MY code. I tend to try to keep it simple. But what do I
know?

 

[Don Guillett]

Perhaps you would benefit from a RE read of the OP desires (as I did)
and a test of MY code. I tend to try to keep it simple. But what do I
know?- Hide quoted text -

- Show quoted text -

This should cover the need to have for ANY entry in column A

Private Sub Worksheet_Change(ByVal Target As Range)
Dim tr As Long
tr = Target.Row
Rows(tr).Borders(xlEdgeBottom).LineStyle = xlNone
If Target.Column <> 1 Or Not IsNumeric(Target) Or _
Len(Application.Trim(Target)) < 1 Then Exit Sub
Range(Cells(tr, 2), Cells(tr, Target + 1)) _
..Borders(xlEdgeBottom).LineStyle = xlContinuous
End Sub

 

[GS]

Don Guillett used his keyboard to write :

Perhaps you would benefit from a RE read of the OP desires (as I did)
and a test of MY code. I tend to try to keep it simple. But what do I
know?

You know a heck of a lot more than me, for sure! I had to REread YOUR
suggestion to 'GET IT'! My bad..! Clearly your suggestion is more
efficient. Thanks so much for being persistent!

 

[Vacuum Sealed]

Gent's

Speaking from ( a lesser experienced's point of view ), I am most certainly
grateful, as would the OP for more seasoned guru's to challenge and question
each other as it helps to define what all the gobble-d-goop so it makes it
more understandable and logical.

Keep up the great work both of you as I know, little by little I understand
that little bit more than I did the day before and benefit hugely, along
with the OP I'm sure.

Cheers
Mick

 

[GS]

Vacuum Sealed used his keyboard to write :

Gent's

Speaking from ( a lesser experienced's point of view ), I am most certainly
grateful, as would the OP for more seasoned guru's to challenge and question
each other as it helps to define what all the gobble-d-goop so it makes it
more understandable and logical.

Keep up the great work both of you as I know, little by little I understand
that little bit more than I did the day before and benefit hugely, along with
the OP I'm sure.

Cheers
Mick

Mick,
I reiterate your comments. I too learn more from these more experienced
contributors. Just like to give some back when I can...