I need to remove all borders on a number of worksheets using VBA. At present I can clear the data but not the borders. My code is :
Sub Clear_Worksheets()
Dim i As Long, lrow As Long
If MsgBox("This will delete all of the entrants, are you sure you wish to continue", vbYesNo) = vbYes Then
With Worksheets("Entrants")
lrow = .Range("B" & .Rows.Count).End(xlUp).Row
If lrow > 7 Then .Range("B8:I" & lrow).ClearContents
End With
Worksheets("Spaniel Special Puppy").UsedRange.Offset(2, 0).ClearContents
Worksheets("Spaniel Novice").UsedRange.Offset(2, 0).ClearContents
Worksheets("Spaniel Open").UsedRange.Offset(2, 0).ClearContents
Worksheets("Retriever Special Puppy").UsedRange.Offset(2, 0).ClearContents
Worksheets("Retriever Novice").UsedRange.Offset(2, 0).ClearContents
Worksheets("Retriever Open").UsedRange.Offset(2, 0).ClearContents
With Worksheets("Entrants")
lrow = .Range("B" & .Rows.Count).End(xlUp).Row
For i = 2 To lrow
If .Range("D" & i).Value = "Y" Then
.Range("A" & i & ":C" & i).Copy Worksheets("Spaniel Special Puppy").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
ElseIf .Range("E" & i).Value = "Y" Then
.Range("A" & i & ":C" & i).Copy Worksheets("Spaniel Novice").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
ElseIf .Range("F" & i).Value = "Y" Then
.Range("A" & i & ":C" & i).Copy Worksheets("Spaniel Open").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
ElseIf .Range("G" & i).Value = "Y" Then
.Range("A" & i & ":C" & i).Copy Worksheets("Retriever Special Puppy").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
ElseIf .Range("H" & i).Value = "Y" Then
.Range("A" & i & ":C" & i).Copy Worksheets("Retriever Novice").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
ElseIf .Range("I" & i).Value = "Y" Then
.Range("A" & i & ":C" & i).Copy Worksheets("Retriever Open").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
End If
Next i
End With
For i = 1 To Worksheets.Count
With Worksheets(i)
If .Name <> "Entrants" Then
For ii = 3 To 100 Step 1
.Rows(ii).Interior.ColorIndex = 0
Next ii
End If
End With
Next i
End If
End Sub
Bookmarks