Insert Border When A Value Changes

[hrayani]

Hello Friends,

I am using the below code ( i found it on the web) to insert a border from Column A to L whenever a value changes in column B.

Sub Test()      
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim rng As Range
    For Each rng In Range("B4:B" & LastRow)
        If rng <> rng.Offset(1, 0) Then
            Range("A" & rng.Row & ":L" & rng.Row).Borders(xlEdgeBottom).LineStyle = xlContinuous
            
            
            
        End If
    Next rng
  
End Sub

What i want is a thick border line whereas the code is inserting a thin line. I am sure a small change is needed in the code but i am unable to do it.

Any help would be appreciated.

Regards,

Humayun

 

[James006]

Hello,

Just test the following : .Weight = xlMedium

[COLOR=#333333]Range("A" & rng.Row & ":L" & rng.Row).Borders(xlEdgeBottom).LineStyle = xlContinuous
[/COLOR][COLOR=#333333]Range("A" & rng.Row & ":L" & rng.Row).Borders(xlEdgeBottom).Weight = xlMedium[/COLOR]

HTH

 

[hrayani]

Thanks james006

Worked Great... Thanks very much

One more thing

Can the code insert thin vertical lines also ??

Regards,

Humayun

 

[hrayani]

Sorry i forgot to add one thing...


1) Horizontal thin lines on the entire table
2) Horizontal thick lines when the value changes -- which the code is doing right now
3) Vertical thin line on the entire table

 

[James006]

You are welcome ...

If you need to look for any specific border instruction ... a simple trick ...

Just turn on your macro recorder and perform the required actions ...

You will get the ' VBA translation ' ... :wink:

 

[hrayani]

Yes i tried to do the same and came up with the following long code.

 Range("A4:L4").Select    Range(Selection, Selection.End(xlDown)).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With

1) is there a way to shorten it ?
2) also i am still unable to insert thin horizontal line in the table. as soon as i insert the line the major thick lines disappear which is there where the value changes

Any idea ??

 

[James006]

Hello again,

Just use

Selection.Borders(xlInsideVertical).Weight = xlThin

HTH

 

[hrayani]

Hi James,

Thanks for the support....

Here is the final code i have come up with

Sub ALL()    
    Application.ScreenUpdating = False
    
 
    
   'remove border start'
    Range("A4:L4").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Borders.LineStyle = xlLineStyleNone
    'remove border end'
    
    
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim rng As Range
    For Each rng In Range("B4:B" & LastRow)
        If rng <> rng.Offset(1, 0) Then
            Range("A" & rng.Row & ":L" & rng.Row).Borders(xlEdgeBottom).LineStyle = xlContinuous
            Range("A" & rng.Row & ":L" & rng.Row).Borders(xlEdgeBottom).Weight = xlThick
                        
        End If
        Next rng
     
    'place vertical border start'
    Range("A4:L4").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Borders(xlInsideVertical).Weight = xlThin
    Selection.Borders(xlEdgeBottom).Weight = xlThick
    Selection.Borders(xlEdgeRight).Weight = xlThick
    Selection.Borders(xlEdgeLeft).Weight = xlThick
    'place vertical border end'
    
    Range("A1").Select
    Application.ScreenUpdating = True
    
   
End Sub

One last thing .....
I want the cell to be filled with colour when the cell value changes.

Like for the 1st partition it could be red and for the 2nd partition it could be blue and for the 3rd again red and so on
we can go on with two colours.

Any idea ???

 

[James006]

Glad you could solve your first problem

Regarding the 3 Colors ... never had this problem ...

My guess would be you will need to split your 12 Column range into three 4 Column sub-range before applying your colors ...

 

[hrayani]

Hi James,

My guess would be you will need to split your 12 Column range into three 4 Column sub-range before applying your colors

I cannot split the column range as it is not constant & keeps on changing. So i would need a code to automatically change the cell color of partitions created with borders with the earlier code.

Secondly, i think i should start a new thread clearly mentioning as the problem of the current thread is solved.

Regards,

Humayun