VBA code to create a border around used cells in all worksheets

[Milos]

Hello excel champions,

I'm recording a macro and would like some VBA code help. I'm trying to make a border around all used cells in all worksheets (I have around 50 worksheets open at one time). When I use the macro there will be a variable number of used cells.

I would love help designing a code to cater to my three needs:

• If cell A1 has text then format cells A2:G2 with an outline border

• Repeat for each row in the sheet until there is no more text in column A.
• Do this for all worksheets in this workbook

I have managed to complete my macro to cater to the first two bullet points, but not quite the third bullet point.

Thanks so much for your help!

Milos

 

[DushiPunda]

Dim ws As Worksheet
For Each ws In ActiveWorkbook 'or ThisWorkbook
    'Your Code Goes Here
Next

You'll likely need to modify the code you already have...For example, in the code you have, if you have:

Worksheets("Sheet1").Range("A2:G2").blah

You'll need to substitute the red text with "ws", like so:

ws.Range("A2:G2").blah

Hopefully that makes sense. If it doesn't, post the code you already have and I'll show you what you need to change

 

[Milos]

Thanks DushiPanda,

Way out of my depth with multiple worksheets..

[COLOR=#000000][FONT=Menlo]Sub AllWorksheetBorders()[/FONT][/COLOR][FONT=Menlo]
[/FONT]
[COLOR=#000000][FONT=Menlo]Application.ScreenUpdating = [COLOR=#011993]False[/COLOR] [COLOR=#008F00]'Prevents screen refreshing[/COLOR][/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo][COLOR=#011993]Dim[/COLOR] lngLstCol [COLOR=#011993]As[/COLOR] [COLOR=#011993]Long[/COLOR], lngLstRow [COLOR=#011993]As[/COLOR] [COLOR=#011993]Long[/COLOR] [COLOR=#008F00]'[/COLOR][/FONT][/COLOR]
[FONT=Menlo]
[/FONT]
[COLOR=#000000][FONT=Menlo]lngLstRow = ActiveSheet.UsedRange.Rows.Count[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]lngLstCol = ActiveSheet.UsedRange.Columns.Count[/FONT][/COLOR]
[FONT=Menlo]
[/FONT]
[COLOR=#000000][FONT=Menlo][COLOR=#011993]For[/COLOR] [COLOR=#011993]Each[/COLOR] rngCell [COLOR=#011993]In[/COLOR] Range("A1:A" & lngLstRow)[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [COLOR=#011993]If[/COLOR] rngCell.Value > "" [COLOR=#011993]Then[/COLOR][/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]        r = rngCell.Row[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]        c = rngCell.Column[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]        Range(Cells(r, c), Cells(r, lngLstCol)).Select[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]            [COLOR=#011993]With[/COLOR] Selection.Borders[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]                .LineStyle = xlContinuous [COLOR=#008F00]'Setting style of border line[/COLOR][/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]                .Weight = xlThin [COLOR=#008F00]'Setting weight of border line[/COLOR][/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]                .ColorIndex = xlAutomatic [COLOR=#008F00]'Setting colour of border line[/COLOR][/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]            [COLOR=#011993]End[/COLOR] [COLOR=#011993]With[/COLOR][/FONT][/COLOR]
[COLOR=#011993][FONT=Menlo][COLOR=#000000]    [/COLOR]End[COLOR=#000000] [/COLOR]If[/FONT][/COLOR]
[COLOR=#011993][FONT=Menlo]Next[/FONT][/COLOR]
[FONT=Menlo]
[/FONT]
[COLOR=#000000][FONT=Menlo]Application.ScreenUpdating = [COLOR=#011993]True[/COLOR]  [COLOR=#008F00]'Enables screen refreshing[/COLOR][/FONT][/COLOR]
[FONT=Menlo]
[/FONT]
[COLOR=#011993][FONT=Menlo]End[COLOR=#000000] [/COLOR]Sub

[/FONT][/COLOR]

 

[Milos]

The code above is what I have so far:

Would you mind showing me what I need to change for this macro to run on all worksheets in a workbook?

 

[MARK858]

Try the amended code below (untested)...

Sub AllWorksheetBorders()

    Application.ScreenUpdating = False    'Prevents screen refreshing
    Dim lngLstCol As Long, lngLstRow As Long, ws As Worksheet

    For Each ws In ActiveWorkbook.Worksheets
        lngLstRow = ws.UsedRange.Rows.Count
        lngLstCol = ws.UsedRange.Columns.Count

        For Each rngCell In ws.Range("A1:A" & lngLstRow)
            If rngCell.Value <> "" Then
                r = rngCell.Row
                c = rngCell.Column

                With ws.Range(ws.Cells(r, c), ws.Cells(r, lngLstCol)).Borders
                    .LineStyle = xlContinuous    'Setting style of border line
                    .Weight = xlThin    'Setting weight of border line
                    .ColorIndex = xlAutomatic    'Setting colour of border line
                End With
            End If
        Next
    Next

    Application.ScreenUpdating = True    'Enables screen refreshing
End Sub

 

[DushiPunda]

Sorry for the late reply and thanks for bumping - I probably wouldn't have seen this if you didn't bump it.

Try this:

Sub AllWorksheetBorders()
Dim lngLstCol As Long, lngLstRow As Long '
Dim rngCell As Range, ws As Worksheet


Application.ScreenUpdating = False 'Prevents screen refreshing


For Each ws In ThisWorkbook.Worksheets
    lngLstRow = ws.UsedRange.Rows.Count
    lngLstCol = ws.UsedRange.Columns.Count
    
    For Each rngCell In Range("A1:A" & lngLstRow)
        If rngCell.Value <> "" Then
            r = rngCell.Row
            c = rngCell.Column
            
            With ws.Range(ws.Cells(r, c), ws.Cells(r, lngLstCol)).Borders
                .LineStyle = xlContinuous 'Setting style of border line
                .Weight = xlThin 'Setting weight of border line
                .ColorIndex = xlAutomatic 'Setting colour of border line
            End With
        End If
    Next
Next


Application.ScreenUpdating = True  'Enables screen refreshing
End Sub

 

[MARK858]

Added the missing variable declarations below to my previous post. By the way why are you using usedrange when you are only bordering column A?

Sub AllWorksheetBorders()

    Application.ScreenUpdating = False    'Prevents screen refreshing
    Dim lngLstCol As Long, lngLstRow As Long, ws As Worksheet
    Dim rngCell As Range, r As Long, c As Long

    For Each ws In ActiveWorkbook.Worksheets
        lngLstRow = ws.UsedRange.Rows.Count
        lngLstCol = ws.UsedRange.Columns.Count

        For Each rngCell In ws.Range("A1:A" & lngLstRow)
            If rngCell.Value <> "" Then
                r = rngCell.Row
                c = rngCell.Column

                With ws.Range(ws.Cells(r, c), ws.Cells(r, lngLstCol)).Borders
                    .LineStyle = xlContinuous    'Setting style of border line
                    .Weight = xlThin    'Setting weight of border line
                    .ColorIndex = xlAutomatic    'Setting colour of border line
                End With
            End If
        Next
    Next

    Application.ScreenUpdating = True    'Enables screen refreshing
End Sub

 

[Milos]

Works perfectly

No worries at all you have done me a big favour!

Thank you so much!

 

[MARK858]

@Milos, just to point out that if you are using UsedRange (besides the fact it retains a memory) if you ever have any blank rows at the top then you wont get the correct results.
Just be careful what your data looks like going down the line if you are going to use it.

 

[DushiPunda]

MARK858, he's not only bordering column A...that's just his reference point - if the cell in column A is not blank, then border from A to lngLstCol in the same row.