Changing Borders In A Document With Vba

[Soxfan26]

Hello,

I have a report that is imported into excel with all thick borders. Does anyone know a VBA code (or simpler way) to change all of these borders to skinny borders? Thanks.

[Craig Ottley]

something like this should help you

 
Sub formatCurrentRegion() 
     
    Selection.CurrentRegion.Select 
     
    With Selection 
        .Borders(xlDiagonalDown).LineStyle = xlNone 
        .Borders(xlDiagonalUp).LineStyle = xlNone 
        .Borders(xlEdgeLeft).LineStyle = xlContinuous 
        .Borders(xlEdgeLeft).Weight = xlThin 
        .Borders(xlEdgeLeft).ColorIndex = xlAutomatic 
        .Borders(xlEdgeTop).LineStyle = xlContinuous 
        .Borders(xlEdgeTop).Weight = xlThin 
        .Borders(xlEdgeTop).ColorIndex = xlAutomatic 
        .Borders(xlEdgeBottom).LineStyle = xlContinuous 
        .Borders(xlEdgeBottom).Weight = xlThin 
        .Borders(xlEdgeBottom).ColorIndex = xlAutomatic 
        .Borders(xlEdgeRight).LineStyle = xlContinuous 
        .Borders(xlEdgeRight).Weight = xlThin 
        .Borders(xlEdgeRight).ColorIndex = xlAutomatic 
        .Borders(xlInsideVertical).LineStyle = xlContinuous 
        .Borders(xlInsideVertical).Weight = xlThin 
        .Borders(xlInsideVertical).ColorIndex = xlAutomatic 
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous 
        .Borders(xlInsideHorizontal).Weight = xlThin 
        .Borders(xlInsideHorizontal).ColorIndex = xlAutomatic 
    End With 
     
End Sub 

[shg]

Or this:

Sub x() 
     
    Dim rCel As Range 
    Dim iEdge As Integer 
     
    Application.ScreenUpdating = False 
    For Each rCel In ActiveSheet.UsedRange 
        With rCel 
            For iEdge = xlDiagonalDown To xlEdgeRight 
                If .Borders(iEdge).LineStyle <> xlLineStyleNone Then 
                    .Borders(iEdge).LineStyle = xlContinuous 
                    .Borders(iEdge).Weight = xlHairline 
                End If 
            Next 
        End With 
    Next 
    Application.ScreenUpdating = True 
     
End Sub 

[Soxfan26]

Thanks! This worked perfectly.

Or this:

Sub x() 
     
    Dim rCel As Range 
    Dim iEdge As Integer 
     
    Application.ScreenUpdating = False 
    For Each rCel In ActiveSheet.UsedRange 
        With rCel 
            For iEdge = xlDiagonalDown To xlEdgeRight 
                If .Borders(iEdge).LineStyle <> xlLineStyleNone Then 
                    .Borders(iEdge).LineStyle = xlContinuous 
                    .Borders(iEdge).Weight = xlHairline 
                End If 
            Next 
        End With 
    Next 
    Application.ScreenUpdating = True 
     
End Sub 

[shg]

Great, you're welcome.