• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 328
  • Last Modified:

Clear all "thin" weighted borders on a worksheet

I have a worksheet that has borders formated with a 'xlMedium' and 'xlThin' weight.  I need a macro that will remove all borders with an 'xlThin' weight to 'xlNone'.  Any help would be greatly appreciated.  Thanks!
0
KP_SoCal
Asked:
KP_SoCal
  • 4
  • 3
  • 2
1 Solution
 
Ingeborg Hawighorst (Microsoft MVP / EE MVE)Microsoft MVP ExcelCommented:
Hello,

something like this, maybe

Sub ThinToNone()
Dim ws As Worksheet
Dim cel As Range
Dim lRow As Long, lCol As Long

Set ws = ThisWorkbook.Worksheets("Sheet1")  ' change sheet name as required
lRow = ActiveCell.SpecialCells(xlLastCell).Row
lCol = ActiveCell.SpecialCells(xlLastCell).Column

Range("A1").Select
For Each cel In Range("A1", Cells(lRow, lCol))
    If cel.Borders(xlEdgeBottom).Weight = xlThin Then cel.Borders(xlEdgeBottom).LineStyle = xlNone
    If cel.Borders(xlEdgeTop).Weight = xlThin Then cel.Borders(xlEdgeTop).LineStyle = xlNone
    If cel.Borders(xlEdgeRight).Weight = xlThin Then cel.Borders(xlEdgeRight).LineStyle = xlNone
    If cel.Borders(xlEdgeLeft).Weight = xlThin Then cel.Borders(xlEdgeLeft).LineStyle = xlNone
Next cel

End Sub

Open in new window


cheers, teylyn
0
 
broro183Commented:
hi everyone,

Not for points.

Teylyn your "ws" variable seems to be unloved so I've helped it feel more important with a couple of modifications to remove the relevance of the "activesheet" when the code is run. ;-)

Option Explicit
Public glb_origCalculationMode As Long
Public glb_origStatusBar As String

Sub ThinToNone_Alternative()
Dim ws As Worksheet
Dim cel As Range
Dim lRow As Long, lCol As Long
Dim brdr As Border
Dim TestNumOfRows As Long    'used to force a "reset" of the worksheet's used range.

    'to help the macro run faster by turning off some excel application level settings
    Call ToggleRefreshXlApp(False)

    Set ws = ThisWorkbook.Worksheets("Sheet1")  ' change sheet name as required

    With ws
        'this next line forces excel to re-evaluate the "Used Range",
        'which ensures "xlLastCell" is more accurate.
        TestNumOfRows = .UsedRange.Rows.Count
        With .Cells(1, 1).SpecialCells(xlLastCell)
            lRow = .Row
            lCol = .Column
        End With

        'optional extra which to select cell A1
        Application.Goto .Cells(1, 1)

        For Each cel In .Range("A1", .Cells(lRow, lCol))
            '            'If the borders could be any of the following xlBordersIndex constants/types (see excel help files):
            '            'xlDiagonalDown, xlDiagonalUp, xlEdgeBottom, xlEdgeLeft, xlEdgeRight, or xlEdgeTop, xlInsideHorizontal, or xlInsideVertical",
            '            'then this approach may be useful.
            '            For Each brdr In cel.Borders
            '                With brdr
            '                    If .Weight = xlThin Then .LineStyle = xlNone
            '                End With
            '            Next brdr

            'However, if the border may only be one of the types that Teylyn listed,
            'then I think her code will be faster.
            With cel
                If .Borders(xlEdgeBottom).Weight = xlThin Then .Borders(xlEdgeBottom).LineStyle = xlNone
                If .Borders(xlEdgeTop).Weight = xlThin Then .Borders(xlEdgeTop).LineStyle = xlNone
                If .Borders(xlEdgeRight).Weight = xlThin Then .Borders(xlEdgeRight).LineStyle = xlNone
                If .Borders(xlEdgeLeft).Weight = xlThin Then .Borders(xlEdgeLeft).LineStyle = xlNone
            End With
        Next cel
    End With

    'reset the excel application level settings
    Call ToggleRefreshXlApp(True)
    MsgBox "done"

    Set ws = Nothing
End Sub

Sub ToggleRefreshXlApp(RefreshAppSettings As Boolean, Optional ByRef xlApp As Excel.Application)
    If xlApp Is Nothing Then
        Set xlApp = Excel.Application
    End If
    With xlApp
        If Not RefreshAppSettings Then
            glb_origCalculationMode = .Calculation
            glb_origStatusBar = .StatusBar
        End If
        .EnableEvents = RefreshAppSettings
        On Error Resume Next
        '        .Calculation = IIf(RefreshAppSettings, glb_origCalculationMode, xlCalculationManual)
        .Calculation = IIf(RefreshAppSettings, xlCalculationAutomatic, xlCalculationManual)
        On Error GoTo 0
        .StatusBar = IIf(RefreshAppSettings, vbNullString, CBool(glb_origStatusBar))
        .ScreenUpdating = RefreshAppSettings
    End With
    Set xlApp = Nothing
End Sub

Open in new window


hth
Rob
0
 
Ingeborg Hawighorst (Microsoft MVP / EE MVE)Microsoft MVP ExcelCommented:
Thanks, bro =)

I first wrote the code without the ws reference, using ActiveSheet only. Then I thought to make it more robust, but did not finish it.

I find it runs without issues, though.

How do you churn out things like these so fast?

(Summer's here. Shorts and tank tops all over the place yesterday. Feels great)
0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
KP_SoCalAuthor Commented:
Sorry to reply so late to this.  I'll test this out in a bit.  Based on the people that are recommending it, I'm sure it will work just fine.  Rob, since you are declining the points, I will be awarding them all to Ms. Teylyn.  Thank you all for your help. ;-)

kp
0
 
broro183Commented:
hi everyone,

Kp, I'm pleased we could help :-)

Teylyn,
I wasn't churning it out fast - it's all your work which is why I didn't want any points. All I really had to do was select your code, [ctrl + c], [alt + tab], [ctrl + v], scribble a few extra comments, change a line or two of code, add my standard sub, run SmartIndenter over it again & then paste it into a post :-)

I think I just finished adding the flexibility that you started with the "ws" variable (great minds think alike, huh?), & maybe improved the speed slightly by wrapping it in my ToggleSettings sub.

It's good to hear that it is summer back home in NZ, it is starting to get dark earlier over here in the UK. I'll send you a message via TheCodeCage.com...

Rob
0
 
KP_SoCalAuthor Commented:
This is excellent!  I thank you again.  I finally go around to applying it, and it works beauifully.  On more question related to this though.  Is there a way to easily modify this code so I can apply this to both Sheet1 and SheetC?  

Telyn, is it true that AU is a small island of the coast of NZ?  ;-)


0
 
KP_SoCalAuthor Commented:
Nevermind guys, I figured it out.  Have a great weekend!

Public Sub RemoveBorders()
Sheets("Sheet1").Select
Call ThinToNone_Alternative

Sheets("Sheet2").Select
Call ThinToNone_Alternative

End Sub

Open in new window

0
 
broro183Commented:
hi Kp,

Here is a slight untested change (see the '### sections) to my last code posting, to introduce you to the technique of passing parameters/arguments to your subs. Awareness of this technique can help make you better at writing flexible code which is more generic & re-usable.

Option Explicit
Public glb_origCalculationMode As Long
Public glb_origStatusBar As String

Sub ThinToNone_Alternative(ws As Worksheet)
'### DELETE Dim ws As Worksheet
Dim cel As Range
Dim lRow As Long, lCol As Long
Dim brdr As Border
Dim TestNumOfRows As Long    'used to force a "reset" of the worksheet's used range.

    'to help the macro run faster by turning off some excel application level settings
    Call ToggleRefreshXlApp(False)

'### DELETE     Set ws = ThisWorkbook.Worksheets("Sheet1")  ' change sheet name as required

    With ws
        'this next line forces excel to re-evaluate the "Used Range",
        'which ensures "xlLastCell" is more accurate.
        TestNumOfRows = .UsedRange.Rows.Count
        With .Cells(1, 1).SpecialCells(xlLastCell)
            lRow = .Row
            lCol = .Column
        End With

        'optional extra which to select cell A1
        Application.Goto .Cells(1, 1)

        For Each cel In .Range("A1", .Cells(lRow, lCol))
            '            'If the borders could be any of the following xlBordersIndex constants/types (see excel help files):
            '            'xlDiagonalDown, xlDiagonalUp, xlEdgeBottom, xlEdgeLeft, xlEdgeRight, or xlEdgeTop, xlInsideHorizontal, or xlInsideVertical",
            '            'then this approach may be useful.
            '            For Each brdr In cel.Borders
            '                With brdr
            '                    If .Weight = xlThin Then .LineStyle = xlNone
            '                End With
            '            Next brdr

            'However, if the border may only be one of the types that Teylyn listed,
            'then I think her code will be faster.
            With cel
                If .Borders(xlEdgeBottom).Weight = xlThin Then .Borders(xlEdgeBottom).LineStyle = xlNone
                If .Borders(xlEdgeTop).Weight = xlThin Then .Borders(xlEdgeTop).LineStyle = xlNone
                If .Borders(xlEdgeRight).Weight = xlThin Then .Borders(xlEdgeRight).LineStyle = xlNone
                If .Borders(xlEdgeLeft).Weight = xlThin Then .Borders(xlEdgeLeft).LineStyle = xlNone
            End With
        Next cel
    End With

    'reset the excel application level settings
    Call ToggleRefreshXlApp(True)
    MsgBox "done"

'### MAYBE DELETE     I don't think this should be here anymore more, but try your code with & without it & see if it causes any problems (I think it may only cause a problem having it, if you were to pass this sub a worksheet [u]variable[/u] rather than an explicitly named worksheet object, ie a variable that you try to re-use in the parent sub. If it doesn't seem to cause a problem with this line of code then I am personally likely to keep it....    Set ws = Nothing
End Sub

Sub ToggleRefreshXlApp(RefreshAppSettings As Boolean, Optional ByRef xlApp As Excel.Application)
    If xlApp Is Nothing Then
        Set xlApp = Excel.Application
    End If
    With xlApp
        If Not RefreshAppSettings Then
            glb_origCalculationMode = .Calculation
            glb_origStatusBar = .StatusBar
        End If
        .EnableEvents = RefreshAppSettings
        On Error Resume Next
        '        .Calculation = IIf(RefreshAppSettings, glb_origCalculationMode, xlCalculationManual)
        .Calculation = IIf(RefreshAppSettings, xlCalculationAutomatic, xlCalculationManual)
        On Error GoTo 0
        .StatusBar = IIf(RefreshAppSettings, vbNullString, CBool(glb_origStatusBar))
        .ScreenUpdating = RefreshAppSettings
    End With
    Set xlApp = Nothing
End Sub

Open in new window


Now when you call the code, you don't need to ".select" the relevant sheet first (".select" slows code down & usually you don't need to use ".select" or ".activate", you can act "directly on the relevant object") as shown below.

Public Sub RemoveBorders()
          Call ThinToNone_Alternative (Sheets("Sheet1"))
          Call ThinToNone_Alternative (Sheets("Sheet2"))
End Sub

Open in new window


hth
Rob
0
 
KP_SoCalAuthor Commented:
Beautiful!  Thank you again!!!
0

Featured Post

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

  • 4
  • 3
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now