Adding a line in a row

  • Thread starter Thread starter CAM
  • Start date Start date
C

CAM

Hello,


I would like to add a border using vba coding to a worksheet this should
only applies when there is a cell containing the text "Total" in column A.
Now I want the border on top of the "Total" starting from column A - H. The
worksheet is large and will have many "Total" in it. How do I code that?
Any tips will be appreciated. Thank you in advance.

Regards,
 
Try this macro...

Sub BorderOnTotal()
Dim R As Range
Dim FirstAddress As String
With Worksheets("Sheet3").Columns(1)
Set R = .Find("Total")
If Not R Is Nothing Then
FirstAddress = R.Address
Do
R.Borders(xlEdgeTop).LineStyle = xlContinuous
Set R = .FindNext(R)
Loop While Not R Is Nothing And R.Address <> FirstAddress
End If
End With
End Sub
 
Whoops! I forgot the A to H part. Try this macro instead...

Sub BorderOnTotal()
Dim R As Range
Dim FirstAddress As String
With Worksheets("Sheet3").Columns(1)
Set R = .Find("Total")
If Not R Is Nothing Then
FirstAddress = R.Address
Do
R.Resize(1, 8).Borders(xlEdgeTop).LineStyle = xlContinuous
Set R = .FindNext(R)
Loop While Not R Is Nothing And R.Address <> FirstAddress
End If
End With
End Sub
 
Try this
Sub underlineabovetotal()
With Worksheets("sheet3").Range("a1:a500")
Set c = .Find("Total", After:=Range("a1"), LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext,MatchCase:=False)

If Not c Is Nothing Then
firstAddress = c.Address
Do
With .cells(c.Row - 1, "a").Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
End With
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With

End Sub
 
Rick I changed from ("Sheet3") to ("Sheet1"). Thanks for you help. I
really appreciate your skills.

Regards,
 
Thanks Don, I appreciate the tip.

Regards,

Don Guillett said:
Try this
Sub underlineabovetotal()
With Worksheets("sheet3").Range("a1:a500")
Set c = .Find("Total", After:=Range("a1"), LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext,MatchCase:=False)

If Not c Is Nothing Then
firstAddress = c.Address
Do
With .cells(c.Row - 1, "a").Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
End With
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With

End Sub

--
Don Guillett
Microsoft MVP Excel
SalesAid Software
(e-mail address removed)
Click to expand...
 
Back
Top