borders between 2 specific words
Hi all,
I have this bit of code that I need help with:
Code:
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim lRow As Long
Dim LR1 As Long
Dim LR2 As Long
Dim LC As Long
With ActiveSheet.Cells
.Interior.ColorIndex = xlNone
.Borders.LineStyle = xlNone
On Error GoTo skip
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
LR1 = .Find("word1", .Cells(1, 1), xlFormulas, xlPart, xlByRows, xlPrevious, False, False).Row + 1
LR2 = .Find("word2", .Cells(1, 1), xlFormulas, xlPart, xlByRows, xlPrevious, False, False).Row - 1
LC = .Find("*", .Cells(1, 1), xlFormulas, xlPart, xlByColumns, xlPrevious, False, False).Column
End With
lRow = 0
For lRow = LR1 To LR2 Step 1 'LR1 is "word1" - "LR2 is "word2"
With Range(Cells(lRow, 1), Cells(lRow, LC))
.Interior.ColorIndex = 24
With .Borders
For i = 7 To 11
With .Item(i)
.LineStyle = xlDot
'.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Next i
End With
End With
Next lRow
skip:
If Err Then
MsgBox Err.Description, vbCritical, "ERROR"
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
I am trying to is create borders around all cells in the range by looking for 2 specific words to begin and end the borders. Let's say word1 & word2. The border should begin after (under) word1 and end before (above) word2. It will also happen that there will be several occurrences of word1 & word 2 but it should only create the borders between word1 & word 2 for every occurrence of those words.
Now this code seems to works but only for 1 occurrence of word1 & word2 (from the bottom up) and all the others are ignored :(
Can someone help please ?
Pedy |
