Solved: Excel 2003 - Something faster than a Loop to check the used range surrounding Border

[frank_m]

This routine checks to see if any cells have the thick red border missing that is surrounding the used range.

It takes a few seconds to run for 15,000 rows. Is there a way I can do this faster.

Note: I can not used the change event or any events, because some times the borders are accidentally shifted while the user is in Design mode therefore the target could not be stored in a variable.

* I've attached a sample workbook

Thanks.
Sub Check_If_Red_Borders_Exists()

Dim wks As Worksheet, rng As Range, c As Range, Temp As String
Dim ColumnLetter, Lastrow As Long

Set wks = ActiveSheet

With wks

Lastrow = .[B65536].End(xlUp).Row

Set rng = .Range(.Cells(16, 18), .Cells(Lastrow, 18))

Application.ScreenUpdating = False

'Check used range right side thick red column border
For Each c In rng
If c.Borders(xlEdgeLeft).Weight <> xlThick Then
Temp = Temp & ";" & c.Row 'v
End If
Next c



'Check Botton Row thick red border
Set rng = .Range(.Cells(Lastrow, 1), .Cells(Lastrow, 17))

For Each c In rng

If c.Borders(xlEdgeBottom).LineStyle = xlNone Then

ColumnLetter = Chr(c.Column + 64)

MsgBox "E R R O R -- Column (" & ColumnLetter & ") cell/cells inserted causing" _
& "corrupted data in the DATA Sheet. ->Notify administrator.", vbCritical

End If

Next c

End With

Application.ScreenUpdating = True

On Error Resume Next

MsgBox "E R R O R -- Row/s (" & Right(Trim(Temp), Len(Trim(Temp)) - 1) & _
") missing right side red border/s in the DATA Sheet." _
& "Data Corruption Likely." & vbNewLine & _
"->Notify the administrator", vbCritical

End Sub

[Bob Phillips]

Rather than check if it is so, why not just apply the thick red border around the usedrange, that should be fast.

[frank_m]

Well, I can't do that because the whole purpose is so I know if any cells have been shifted by a deletion or insertion of a cell, thereby corrupting the row records.

[frank_m]

I got it to be super fast now, averaging less than 1/4 of a Second

All I really did was remove the temp variable storing mechanism that was for storing a list of "rows found"

Even if there are dozens of borders missing, I do not need a list. The new version of the code pops up a message for each instance that it finds.

So, being that it's rare to have any borders missing, and when there is it's almost always only one or two, this is more than adequate.

Sub Check_If_Red_Borders_Exists()

Dim wks As Worksheet, rng As Range, c As Range
Dim ColumnLetter, Lastrow As Long

Dim t As Single: t = Timer

Set wks = ActiveSheet

With wks

Lastrow = .[B65536].End(xlUp).Row

Set rng = .Range(.Cells(16, 18), .Cells(Lastrow, 18))

'Check used range for any missing right side thick red column border
For Each c In rng
If c.Borders(xlEdgeLeft).Weight <> xlThick Then

MsgBox "E R R O R -- A cell was Inserted or Deleted " _
& "in Row: " & c.Row & " causing data to be corrupted. - Please notify the administrator.", vbCritical

End If
Next c

'Check Bottom Row thick red border
Set rng = .Range(.Cells(Lastrow, 1), .Cells(Lastrow, 17))

For Each c In rng

If c.Borders(xlEdgeBottom).LineStyle = xlNone Then

ColumnLetter = Chr(c.Column + 64)

MsgBox "E R R O R -- Column (" & ColumnLetter & ") cell/cells inserted causing" _
& "corrupted data in the DATA Sheet. ->Notify administrator.", vbCritical

End If

Next c

End With

MsgBox "Done! " & Format(Timer - t, "0.000") & " seconds"

End Sub