smaller code

chad1222

Board Regular
Joined
Jul 14, 2003
Messages
133
can anyone help me get this code any smaller, it is taking almost 2 seconds to run.

Code:
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
 

Excel Facts

When did Power Query debut in Excel?
Although it was an add-in in Excel 2010 & Excel 2013, Power Query became a part of Excel in 2016, in Data, Get & Transform Data.

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
60,909
Office Version
  1. 365
Platform
  1. Windows
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

Well-known Member
Joined
Apr 29, 2002
Messages
677
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
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,152,332
Messages
5,769,470
Members
425,552
Latest member
learnerrr

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top