If cell value changes, add bottom border

[deduwa]

Hi,

I have a dynamic number of rows, and set number of columns up to column S.

I want to automate where the code starts in cell S5, and goes down column S only to the bottom of the table such that;

- If the very 1st character of the next cell down is the same the very 1st character of the current cell then do nothing

- If the very 1st character of the next cell down is not the same as the very 1st character of the current cell then add a thin bottom border from column A through to column R inclusive (i.e. so the effect is to separate in sections using border to show when one section finishes and another starts)

Can this be automated?

Thanks

 

[Fluff]

How about

Sub AddBorder()
   Dim i As Long
   
   For i = 5 To Range("S" & Rows.Count).End(xlUp).Row
      If Left(Range("S" & i).Value, 1) <> Left(Range("S" & i + 1).Value, 1) Then
         Range("A" & i).Resize(, 18).Borders(xlEdgeBottom).Weight = xlThin
      End If
   Next i
End Sub

 

[mumps]

Copy and paste this macro into the worksheet code module. Do the following: right click the tab for your sheet and click 'View Code'. Paste the macro into the empty code window that opens up. Close the code window to return to your sheet. Make an entry in column S and exit the cell.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("S5", Range("S" & Rows.Count).End(xlUp))) Is Nothing Then Exit Sub
    If Left(Target.Offset(1, 0), 1) <> Left(Target, 1) Then
        Range("A" & Target.Row & ":R" & Target.Row).Borders(xlEdgeBottom).LineStyle = xlContinuous
    End If
End Sub

 

[aloxaz]

Hi,

I have a dynamic number of rows, and set number of columns up to column S.

I want to automate where the code starts in cell S5, and goes down column S only to the bottom of the table such that;

- If the very 1st character of the next cell down is the same the very 1st character of the current cell then do nothing

- If the very 1st character of the next cell down is not the same as the very 1st character of the current cell then add a thin bottom border from column A through to column R inclusive (i.e. so the effect is to separate in sections using border to show when one section finishes and another starts)

Can this be automated?

Thanks

Sub test()


Dim LastrowS As Long
Dim i As Long
Dim CurrentCharacter As String
Dim NextCharacter As String


LastrowS = Sheet1.Range("S" & Rows.Count).End(xlUp).Row

For i = 5 To LastrowS

CurrentCharacter = Left((Sheet1.Range("S" & i)), 1)
NextCharacter = Left((Sheet1.Range("S" & i + 1)), 1)

If CurrentCharacter = NextCharacter Then

Else
With Sheet1.Range("A" & i & ":S" & i).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
End If
Next i

End Sub

 

[deduwa]

Thanks Fluff - I used your suggestion and it works. It puts a bottom border on the very last row, is there a way so that the very last row of the table does not have a bottom border?

Thanks

 

[Fluff]

Make the change in red

For i = 5 To Range("S" & Rows.Count).End(xlUp).Row [COLOR=#ff0000]- 1[/COLOR]