smaller code

[chad1222]

can anyone help me get this code any smaller, it is taking almost 2 seconds to run.

Sub reformatidf()


    ActiveSheet.Unprotect
    If ActiveSheet.Range("A3").Value > 0 Then
        ActiveSheet.Range("C25:C28").Value = "VLAN 501"
    Else: ActiveSheet.Range("C25:C28").ClearContents
    End If
    If ActiveSheet.Range("I3").Value > 0 Then
        ActiveSheet.Range("K25:K28").Value = "VLAN 501"
    Else: ActiveSheet.Range("K25:K28").ClearContents
    End If
    If ActiveSheet.Range("A32").Value > 0 Then
        ActiveSheet.Range("C54:C57").Value = "VLAN 501"
    Else: ActiveSheet.Range("C54:C57").ClearContents
    End If
    If ActiveSheet.Range("I32").Value > 0 Then
        ActiveSheet.Range("K54:K57").Value = "VLAN 501"
    Else: ActiveSheet.Range("K54:K57").ClearContents
    End If
    If ActiveSheet.Range("A61").Value > 0 Then
        ActiveSheet.Range("C83:C86").Value = "VLAN 501"
    Else: ActiveSheet.Range("C83:C86").ClearContents
    End If
    If ActiveSheet.Range("I61").Value > 0 Then
        ActiveSheet.Range("K83:K86").Value = "VLAN 501"
    Else: ActiveSheet.Range("K83:K86").ClearContents
    End If
    
    Columns("A:B").EntireColumn.AutoFit
    Columns("C:C").ColumnWidth = 18
    Columns("D:G").EntireColumn.AutoFit
    Columns("H:H").ColumnWidth = 1.14
    Columns("i:o").EntireColumn.AutoFit
    
    Columns("P:AA").Interior.ColorIndex = 15
    Rows("89:200").Interior.ColorIndex = 15
    
    Range("A1:O88").Interior.ColorIndex = xlNone
    Range("A1:O88").Font.ColorIndex = 0
    Range("A3,I3,A32,I32,A61,I61").Interior.ColorIndex = 41
    Application.EnableEvents = False
    Range( _
        "B3:G3,A4:G4,J3:O3,I4:O4,B32:G32,A33:G33,J32:O32,I33:O33,J61:O61,I62:O62,A62:G62,B61:G61" _
        ).Select
        Selection.Interior.ColorIndex = 40
        With Selection.Font
            .name = "Times New Roman"
            .Size = 12
        End With
    
    For x = 6 To 30 Step 2
    Range("A" & x).EntireRow.Interior.ColorIndex = 15
    Next x
    
    For y = 34 To 59 Step 2
    Range("A" & y).EntireRow.Interior.ColorIndex = 15
    Next y
    
    For z = 63 To 88 Step 2
    Range("A" & z).EntireRow.Interior.ColorIndex = 15
    Next z
    
    
    Range("h3:h88,A31:o31,A60:o60").Interior.ColorIndex = 1
  
    Range("A5:G30,I5:O30,I34:O59,A34:G59,I63:O88,A63:G88").Select
    With Selection.borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
   
    Range("E29:G30,M29:O30,E58:G59,M58:O59,E87:G88,M87:O88").Select
    Selection.Interior.ColorIndex = 1
    
    Range("E3:G3,M3:O3,M32:O32,E32:G32").Select
    
    Selection.borders(xlDiagonalDown).LineStyle = xlNone
    Selection.borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Selection.borders(xlInsideVertical).LineStyle = xlNone
    'ActiveSheet.protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    
 
    
    
    Call uplinkcheck
    
    Range("A1").Select
    
    Application.EnableEvents = True
    
    
End Sub

 

[Joe4]

You may be able to speed it up a little by adding "Application.ScreenUpdating=False" to the beginning of your code and then "Application.ScreenUpdating=True" to the end.

 

[kkknie]

I ran it in less than 0.5 seconds but took out the call to uplinkcheck. Could that be your problem?

Also, the weight and colorindex of the lines probably don't need to be there, since that is the default. Still, it shouldn't cause much extra execution time.

K