Borders Around Cells

I am not very good with VBA in excel.

I have this code below that I use in excel, works fine with one drawback that I repeat it for each worksheet because each worksheet has a different name.

Is it possible in excel to use global code for more that one worksheet without having to repeat the code?

What I want to do is draw a border around cells. Like Row 6 Column A to J using the code below.

Sub DoTheLot()    'Borders
    Dim R As Long         'R represents ROWS,
    Dim R_From As Long
    Dim R_To As Long
    Dim LastCol As Long

    R_From = 5

    With Sheets("KOLETSIS")
        R_To = .Cells(.Rows.Count, "J").End(xlUp).Row
        For R = R_From To R_To
            LastCol = .Cells(R, .Columns.Count).End(xlToLeft).Column

            Select Case Cells(R, "J").Value

            Case "Out of Order"
                .Cells(R, "A").Resize(, LastCol).Font.ColorIndex = 3    'Red
                
                Selection.Borders(xlDiagonalDown).LineStyle = xlNone
                Selection.Borders(xlDiagonalUp).LineStyle = xlNone
                With Selection.Borders(xlEdgeLeft)
                    .LineStyle = xlContinuous
                    .Weight = xlMedium
                    .ColorIndex = xlAutomatic
                End With
                With Selection.Borders(xlEdgeTop)
                    .LineStyle = xlContinuous
                    .Weight = xlMedium
                    .ColorIndex = xlAutomatic
                End With
                With Selection.Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                    .Weight = xlMedium
                    .ColorIndex = xlAutomatic
                End With
                With Selection.Borders(xlEdgeRight)
                    .LineStyle = xlContinuous
                    .Weight = xlMedium
                    .ColorIndex = xlAutomatic
                End With
                Selection.Borders(xlInsideVertical).LineStyle = xlNone

            End Select
        Next R
    End With

End Sub

I would appreciate any help.

Many thanks

Hi kapeller,
Welcome to the forum
change

With Sheets("KOLETSIS")

to

 With activesheet

Many thanks pike

That worked.

Did the other part of the post make sense as I also need to draw a border around cells as in the code?

Hi kapeller
I didnt open the attachment.. Does the border code do the trick?
You can loop the boarder code to make it shorter

                 Dim myarray(), xItem
    myarray = Array(xlEdgeLeft, xlEdgeTop, xlEdgeBottom, xlEdgeRight)
    With Selection
        For Each xItem In myarray
            With .Borders(xItem)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
        Next xItem
    End With

Hi pike

It did not work. This is the entire code including your code.

Sub DoTheLot() 'Borders
Dim R As Long 'R represents ROWS,
Dim R_From As Long
Dim R_To As Long
Dim LastCol As Long
Dim myarray(), xItem

R_From = 37

With ActiveSheet
R_To = .Cells(.Rows.Count, "J").End(xlUp).Row
For R = R_From To R_To
LastCol = .Cells(R, .Columns.Count).End(xlToLeft).Column

Select Case Cells(R, "J").Value

Case "Out of Order"
.Cells(R, "A").Resize(, LastCol).Font.ColorIndex = 3 'Red

myarray = Array(xlEdgeLeft, xlEdgeTop, xlEdgeBottom, xlEdgeRight)
With Selection
For Each xItem In myarray
With .Borders(xItem)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Next xItem
End With
End Select
Next R
End With
End Sub

Hi pike

Your code does put a border around the cells that are highlighted by the mouse.

What I would like to happen is that when it located the value "Out of Order" in column J then what ever row this relates to the entire row has the border example A6 to J6

Many thanks

hi kapeller

Sub DoTheLot()    'Borders
 Dim R As Long
 Dim myarray(), xItem
 myarray = Array(xlEdgeLeft, xlEdgeTop, xlEdgeBottom, xlEdgeRight)
    With ActiveSheet
        For R = 5 To .Range("J" & Rows.Count).End(xlUp).Row
            If .Cells(R, "J").Value = "Out of Order" Then
                With .Cells(R, "J")
                    .Font.ColorIndex = 3    'Red
                    For Each xItem In myarray
                        With .Borders(xItem)
                            .LineStyle = xlContinuous
                            .Weight = xlThin
                            .ColorIndex = xlAutomatic
                        End With
                    Next
                    End With
                End If
            Next R
        End With
 End Sub

just read your last post

Sub DoTheLot()    'Borders
 Dim R As Long
 Dim myarray(), xItem
 myarray = Array(xlEdgeLeft, xlEdgeTop, xlEdgeBottom, xlEdgeRight)
    With ActiveSheet
        For R = 5 To .Range("A" & Rows.Count).End(xlUp).Row
            If .Cells(R, "J").Value = "Out of Order" Then
                With .Range("A" & R & ":J" & R)
                    .Font.ColorIndex = 3    'Red
                    For Each xItem In myarray
                        With .Borders(xItem)
                            .LineStyle = xlContinuous
                            .Weight = xlThin
                            .ColorIndex = xlAutomatic
                        End With
                    Next
                    End With
                End If
            Next R
        End With
 End Sub

Hi pkie

That did the trick

Many thanks for your support. Greatly appreciated it.

Once again many thanks

If you are satisfied with the solution(s) provided, please mark your thread as Solved.

How to mark a thread Solved
Go to the first post
Click edit
Click Go Advanced
Just below the word Title you will see a dropdown with the word No prefix.
Change to Solved
Click Save