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.

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("B1:D1").Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
End Select
End If
End Sub

On Aug 15, 7:06*am, "Vacuum Sealed" wrote:
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("B1:D1").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 tabview codeinsert 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

On Aug 15, 7:06*am, "Vacuum Sealed" wrote:
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("B1:D1").Borders(xlEdgeBottom)
* * * * * * * * .LineStyle = xlContinuous
* * * * * * * * .ColorIndex = 0
* * * * * * * * .TintAndShade = 0
* * * * * * * * .Weight = xlThin
* * * * * * * * End With
* * * * End Select
*End If
End Sub

RE sending
Right click sheet tabview codeinsert 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

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.

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("B1:D1")
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 at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc

On Aug 15, 9:43*am, "Vacuum Sealed" wrote:
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.

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

On Aug 15, 1:55*pm, GS wrote:
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("B1:D1")
* * 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

Don Guillett submitted this idea :
On Aug 15, 1:55*pm, GS wrote:
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("B1:D1")
* * 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

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 at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc

On Aug 15, 3:54*pm, GS wrote:
Don Guillett submitted this idea :





On Aug 15, 1:55 pm, GS wrote:
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("B1:D1")
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

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?

On Aug 15, 5:31*pm, Don Guillett wrote:
On Aug 15, 3:54*pm, GS wrote:





Don Guillett submitted this idea :

On Aug 15, 1:55 pm, GS wrote:
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("B1:D1")
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

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?- 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

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!

--
Garry

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

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

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...

--
Garry

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