Macro speed - how to make faster

P

patayloruk

New Member
Joined
Nov 2, 2005
Messages
9
Hello all, hope someone can push me in the right direction with this one.

I have an excel sheet which is used as a wire list for an aircraft.

I am trying to optomise the code as this routine takes over 10 seconds on sheet activation.

I have 2 versions here but the second is no quicker

FIRST VERSION

Sub copyandsort()
Sheets("Connector pin list").Select
Cells.Select
Selection.Delete
Range("A2").Select
ActiveWindow.FreezePanes = False
nCol = 1
While Not (ColHd = "End of Columns")
ColHd = Sheet3.Cells(1, nCol)
If (ColHd = "WN") Then col1 = nCol
If (ColHd = "From Data 2") Then col2 = nCol
If (ColHd = "To Data 2") Then Col3 = nCol
If (ColHd = "sort") Then Col4 = nCol
If (ColHd = "Diagram") Then Col5 = nCol
If (ColHd = "Wire Type") Then Col6 = nCol
If (ColHd = "Length adjusted") Then Col7 = nCol
If (ColHd = "sort2") Then Col8 = nCol
If (ColHd = "Cable Assy") Then Col9 = nCol
If (ColHd = "From Conn") Then Col10 = nCol
If (ColHd = "To Conn") Then Col11 = nCol
nCol = nCol + 1
Wend
nlin = 2
While Not (Sheet3.Cells(nlin, col1) = "")
txt1 = Sheet3.Cells(nlin, col1)
txt2 = Sheet3.Cells(nlin, col2)
txt3 = Sheet3.Cells(nlin, Col3)
txt4 = Sheet3.Cells(nlin, Col4)
txt5 = Sheet3.Cells(nlin, Col5)
txt6 = Sheet3.Cells(nlin, Col6)
txt7 = Sheet3.Cells(nlin, Col7)
txt8 = Sheet3.Cells(nlin, Col8)
txt9 = Sheet3.Cells(nlin, Col9)
txt10 = Sheet3.Cells(nlin, Col10)
Txt11 = Sheet3.Cells(nlin, Col11)
Sheet6.Cells(nlin - 1, 1) = txt2
Sheet6.Cells(nlin - 1, 2) = txt1
Sheet6.Cells(nlin - 1, 3) = txt3
Sheet6.Cells(nlin - 1, 4) = txt4
Sheet6.Cells(nlin - 1, 5) = txt5
Sheet6.Cells(nlin - 1, 6) = txt6
Sheet6.Cells(nlin - 1, 7) = txt7
Sheet6.Cells(nlin - 1, 9) = txt9
Sheet6.Cells(nlin - 1, 10) = txt10
Sheet6.Cells(nlin - 1, 11) = Txt11
nlin = nlin + 1
Wend
nLin3 = 2
While Not (Sheet3.Cells(nLin3, col1) = "")
txt1 = Sheet3.Cells(nLin3, col1)
txt2 = Sheet3.Cells(nLin3, col2)
txt3 = Sheet3.Cells(nLin3, Col3)
txt4 = Sheet3.Cells(nLin3, Col4)
txt5 = Sheet3.Cells(nLin3, Col5)
txt6 = Sheet3.Cells(nLin3, Col6)
txt7 = Sheet3.Cells(nLin3, Col7)
txt8 = Sheet3.Cells(nLin3, Col8)
txt9 = Sheet3.Cells(nLin3, Col9)
txt10 = Sheet3.Cells(nLin3, Col10)
Txt11 = Sheet3.Cells(nLin3, Col11)
Sheet6.Cells(nlin + nLin3 - 1, 1) = txt3
Sheet6.Cells(nlin + nLin3 - 1, 2) = txt1
Sheet6.Cells(nlin + nLin3 - 1, 3) = txt2
Sheet6.Cells(nlin + nLin3 - 1, 4) = txt8
Sheet6.Cells(nlin + nLin3 - 1, 5) = txt5
Sheet6.Cells(nlin + nLin3 - 1, 6) = txt6
Sheet6.Cells(nlin + nLin3 - 1, 7) = txt7
Sheet6.Cells(nlin + nLin3 - 1, 9) = txt9
Sheet6.Cells(nlin + nLin3 - 1, 10) = Txt11
Sheet6.Cells(nlin + nLin3 - 1, 11) = txt10
nLin3 = nLin3 + 1
Wend
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Range("A1").Select
ActiveCell.FormulaR1C1 = "From"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Wire Code"
Range("C1").Select
ActiveCell.FormulaR1C1 = "To"
Range("E1").Select
ActiveCell.FormulaR1C1 = "Drawing"
Range("F1").Select
ActiveCell.FormulaR1C1 = "Wire Type"
Range("G1").Select
ActiveCell.FormulaR1C1 = "Length"
Rows("2:2").Select
ActiveWindow.FreezePanes = True
Rows("1:1").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.RowHeight = 40
With Selection.Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Cells.Select
Selection.sort Key1:=Range("J1"), Order1:=xlAscending, Key2:=Range("D1") _
, Order2:=xlAscending, Key3:=Range("B1") _
, Order3:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom



Columns("D:D").Select
Selection.ClearContents
Selection.Delete Shift:=xlToLeft
Columns("I:J").Select
Selection.Delete Shift:=xlToLeft
Range("A2").Select
Columns("A:D").ColumnWidth = 18
Columns("E:E").ColumnWidth = 18
ActiveSheet.Shapes("CommandButton1").Select
Selection.ShapeRange.Left = 0
Selection.ShapeRange.Top = 0
Selection.ShapeRange.Width = 96
Selection.ShapeRange.Height = 21
ActiveSheet.Shapes("CommandButton2").Select
Selection.ShapeRange.Left = 100
Selection.ShapeRange.Top = 0
Selection.ShapeRange.Width = 96
Selection.ShapeRange.Height = 21
ActiveSheet.Shapes("CommandButton3").Select
Selection.ShapeRange.Left = 197
Selection.ShapeRange.Top = 0
Selection.ShapeRange.Width = 96
Selection.ShapeRange.Height = 21
ActiveSheet.Shapes("CommandButton4").Select
Selection.ShapeRange.Left = 300
Selection.ShapeRange.Top = 0
Selection.ShapeRange.Width = 150
Selection.ShapeRange.Height = 21
ActiveSheet.Shapes("CommandButton5").Select
Selection.ShapeRange.Left = 460
Selection.ShapeRange.Top = 0
Selection.ShapeRange.Width = 150
Selection.ShapeRange.Height = 21
ActiveSheet.Shapes("CommandButton6").Select
Selection.ShapeRange.Left = 620
Selection.ShapeRange.Top = 0
Selection.ShapeRange.Width = 150
Selection.ShapeRange.Height = 21
ActiveSheet.Shapes("CommandButton7").Select
Selection.ShapeRange.Left = 820
Selection.ShapeRange.Top = 0
Selection.ShapeRange.Width = 10
Selection.ShapeRange.Height = 10


Sheets("Connector pin list").Select
Selection.AutoFilter
CommandButton3.Enabled = False
End Sub


SECOND VERSION

Sub copyandsort()
Sheets("Connector pin list").Select
Cells.Select
Selection.Delete
Range("A2").Select
ActiveWindow.FreezePanes = False
Dim getdata As Range
Application.ScreenUpdating = False
sheet3length = 2
While Not Sheet3.Cells(sheet3length, 4) = ""
sheet3length = sheet3length + 1
Wend

RowRange = "I2:AL" & sheet3length

Set getdata = Worksheets("Wire List Data").Range(RowRange)

rowno = 2
Do
Sheet6.Cells(rowno, 1) = getdata(rowno - 1, 29) ' to
Sheet6.Cells(rowno, 2) = getdata(rowno - 1, 1)
Sheet6.Cells(rowno, 3) = getdata(rowno - 1, 30) ' from
Sheet6.Cells(rowno, 4) = getdata(rowno - 1, 11)
Sheet6.Cells(rowno, 5) = getdata(rowno - 1, 13)
Sheet6.Cells(rowno, 6) = getdata(rowno - 1, 4)
Sheet6.Cells(rowno, 7) = getdata(rowno - 1, 7)
Sheet6.Cells(rowno, 9) = getdata(rowno - 1, 23)
Sheet6.Cells(rowno, 10) = getdata(rowno - 1, 9)
Sheet6.Cells(rowno, 11) = getdata(rowno - 1, 17)

rowno = rowno + 1
Loop Until getdata(rowno - 1, 1) = ""
rowno = sheet3length
rowno2 = 1
Do
Sheet6.Cells(rowno, 1) = getdata(rowno2, 30) ' from
Sheet6.Cells(rowno, 2) = getdata(rowno2, 1)
Sheet6.Cells(rowno, 3) = getdata(rowno2, 29) ' to
Sheet6.Cells(rowno, 4) = getdata(rowno2, 19)
Sheet6.Cells(rowno, 5) = getdata(rowno2, 13)
Sheet6.Cells(rowno, 6) = getdata(rowno2, 4)
Sheet6.Cells(rowno, 7) = getdata(rowno2, 7)
Sheet6.Cells(rowno, 9) = getdata(rowno2, 23)
Sheet6.Cells(rowno, 10) = getdata(rowno2, 17)
Sheet6.Cells(rowno, 11) = getdata(rowno2, 9)

rowno = rowno + 1
rowno2 = rowno2 + 1
Loop Until getdata(rowno2, 1) = ""
Range("A1").Select
ActiveCell.FormulaR1C1 = "From"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Wire Code"
Range("C1").Select
ActiveCell.FormulaR1C1 = "To"
Range("E1").Select
ActiveCell.FormulaR1C1 = "Drawing"
Range("F1").Select
ActiveCell.FormulaR1C1 = "Wire Type"
Range("G1").Select
ActiveCell.FormulaR1C1 = "Length"
Rows("2:2").Select
ActiveWindow.FreezePanes = True
Rows("1:1").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.RowHeight = 40
With Selection.Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Cells.Select
Selection.sort Key1:=Range("J1"), Order1:=xlAscending, Key2:=Range("D1") _
, Order2:=xlAscending, Key3:=Range("B1") _
, Order3:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom



Columns("D:D").Select
Selection.ClearContents
Selection.Delete Shift:=xlToLeft
Columns("I:J").Select
Selection.Delete Shift:=xlToLeft
Range("A2").Select
Columns("A:D").ColumnWidth = 18
Columns("E:E").ColumnWidth = 18
ActiveSheet.Shapes("CommandButton1").Select
Selection.ShapeRange.Left = 0
Selection.ShapeRange.Top = 0
Selection.ShapeRange.Width = 96
Selection.ShapeRange.Height = 21
ActiveSheet.Shapes("CommandButton2").Select
Selection.ShapeRange.Left = 100
Selection.ShapeRange.Top = 0
Selection.ShapeRange.Width = 96
Selection.ShapeRange.Height = 21
ActiveSheet.Shapes("CommandButton3").Select
Selection.ShapeRange.Left = 197
Selection.ShapeRange.Top = 0
Selection.ShapeRange.Width = 96
Selection.ShapeRange.Height = 21
ActiveSheet.Shapes("CommandButton4").Select
Selection.ShapeRange.Left = 300
Selection.ShapeRange.Top = 0
Selection.ShapeRange.Width = 150
Selection.ShapeRange.Height = 21
ActiveSheet.Shapes("CommandButton5").Select
Selection.ShapeRange.Left = 460
Selection.ShapeRange.Top = 0
Selection.ShapeRange.Width = 150
Selection.ShapeRange.Height = 21
ActiveSheet.Shapes("CommandButton6").Select
Selection.ShapeRange.Left = 620
Selection.ShapeRange.Top = 0
Selection.ShapeRange.Width = 150
Selection.ShapeRange.Height = 21
ActiveSheet.Shapes("CommandButton7").Select
Selection.ShapeRange.Left = 820
Selection.ShapeRange.Top = 0
Selection.ShapeRange.Width = 10
Selection.ShapeRange.Height = 10


Sheets("Connector pin list").Select
Selection.AutoFilter
CommandButton3.Enabled = False
End Sub

Any ideas?

please excuse my bad programming. (new to this)
 

Excel Facts

Is there a shortcut key for strikethrough?
Ctrl+S is used for Save. Ctrl+5 is used for Strikethrough. Why Ctrl+5? When you use hashmarks to count |||| is 4, strike through to mean 5.
Sort by date Sort by votes
I don't know if it will speed things up but you don't need all that selecting.

By the way what are you actuallyt doing in the 3 loops at the start? Do you actually need to loop?
Code: 
Sub copyandsort()
    Sheets("Connector pin list").Cells.Delete
    
    ActiveWindow.FreezePanes = False
    
    nCol = 1
    While Not (ColHd = "End of Columns")
        ColHd = Sheet3.Cells(1, nCol)
        If (ColHd = "WN") Then col1 = nCol
        If (ColHd = "From Data 2") Then col2 = nCol
        If (ColHd = "To Data 2") Then Col3 = nCol
        If (ColHd = "sort") Then Col4 = nCol
        If (ColHd = "Diagram") Then Col5 = nCol
        If (ColHd = "Wire Type") Then Col6 = nCol
        If (ColHd = "Length adjusted") Then Col7 = nCol
        If (ColHd = "sort2") Then Col8 = nCol
        If (ColHd = "Cable Assy") Then Col9 = nCol
        If (ColHd = "From Conn") Then Col10 = nCol
        If (ColHd = "To Conn") Then Col11 = nCol
        nCol = nCol + 1
    Wend
    
    nlin = 2
    While Not (Sheet3.Cells(nlin, col1) = "")
        txt1 = Sheet3.Cells(nlin, col1)
        txt2 = Sheet3.Cells(nlin, col2)
        txt3 = Sheet3.Cells(nlin, Col3)
        txt4 = Sheet3.Cells(nlin, Col4)
        txt5 = Sheet3.Cells(nlin, Col5)
        txt6 = Sheet3.Cells(nlin, Col6)
        txt7 = Sheet3.Cells(nlin, Col7)
        txt8 = Sheet3.Cells(nlin, Col8)
        txt9 = Sheet3.Cells(nlin, Col9)
        txt10 = Sheet3.Cells(nlin, Col10)
        Txt11 = Sheet3.Cells(nlin, Col11)
        Sheet6.Cells(nlin - 1, 1) = txt2
        Sheet6.Cells(nlin - 1, 2) = txt1
        Sheet6.Cells(nlin - 1, 3) = txt3
        Sheet6.Cells(nlin - 1, 4) = txt4
        Sheet6.Cells(nlin - 1, 5) = txt5
        Sheet6.Cells(nlin - 1, 6) = txt6
        Sheet6.Cells(nlin - 1, 7) = txt7
        Sheet6.Cells(nlin - 1, 9) = txt9
        Sheet6.Cells(nlin - 1, 10) = txt10
        Sheet6.Cells(nlin - 1, 11) = Txt11
        nlin = nlin + 1
    Wend
    
    nLin3 = 2
    While Not (Sheet3.Cells(nLin3, col1) = "")
        txt1 = Sheet3.Cells(nLin3, col1)
        txt2 = Sheet3.Cells(nLin3, col2)
        txt3 = Sheet3.Cells(nLin3, Col3)
        txt4 = Sheet3.Cells(nLin3, Col4)
        txt5 = Sheet3.Cells(nLin3, Col5)
        txt6 = Sheet3.Cells(nLin3, Col6)
        txt7 = Sheet3.Cells(nLin3, Col7)
        txt8 = Sheet3.Cells(nLin3, Col8)
        txt9 = Sheet3.Cells(nLin3, Col9)
        txt10 = Sheet3.Cells(nLin3, Col10)
        Txt11 = Sheet3.Cells(nLin3, Col11)
        Sheet6.Cells(nlin + nLin3 - 1, 1) = txt3
        Sheet6.Cells(nlin + nLin3 - 1, 2) = txt1
        Sheet6.Cells(nlin + nLin3 - 1, 3) = txt2
        Sheet6.Cells(nlin + nLin3 - 1, 4) = txt8
        Sheet6.Cells(nlin + nLin3 - 1, 5) = txt5
        Sheet6.Cells(nlin + nLin3 - 1, 6) = txt6
        Sheet6.Cells(nlin + nLin3 - 1, 7) = txt7
        Sheet6.Cells(nlin + nLin3 - 1, 9) = txt9
        Sheet6.Cells(nlin + nLin3 - 1, 10) = Txt11
        Sheet6.Cells(nlin + nLin3 - 1, 11) = txt10
        nLin3 = nLin3 + 1
    Wend
    
    Rows("1:1").Insert Shift:=xlDown
    Range("A1") = "From"
    Range("B1") = "Wire Code"
    Range("C1") = "To"
    Range("E1") = "Drawing"
    Range("F1") = "Wire Type"
    Range("G1") = "Length"
    Rows("2:2").Select
    
    ActiveWindow.FreezePanes = True
    
    With Rows("1:1")
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        .RowHeight = 40
        .Name = "Arial"
        .FontStyle = "Bold"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    
    Cells.Sort Key1:=Range("J1"), Order1:=xlAscending, Key2:=Range("D1") _
    , Order2:=xlAscending, Key3:=Range("B1") _
    , Order3:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:= _
    False, Orientation:=xlTopToBottom
    
    Columns("D:D").Delete Shift:=xlToLeft
    Columns("I:J").Delete Shift:=xlToLeft
    
    Columns("A:E").ColumnWidth = 18
    
    With ActiveSheet.Shapes("CommandButton1")
        .ShapeRange.Left = 0
        .ShapeRange.Top = 0
        .ShapeRange.Width = 96
        .ShapeRange.Height = 21
    End With
    
    With ActiveSheet.Shapes("CommandButton2")
        .ShapeRange.Left = 100
        .ShapeRange.Top = 0
        .ShapeRange.Width = 96
        .ShapeRange.Height = 21
    End With
    
    With ActiveSheet.Shapes("CommandButton3")
        .ShapeRange.Left = 197
        .ShapeRange.Top = 0
        .ShapeRange.Width = 96
        .ShapeRange.Height = 21
    End With
    
    
    With ActiveSheet.Shapes("CommandButton4")
        .ShapeRange.Left = 300
        .ShapeRange.Top = 0
        .ShapeRange.Width = 150
        .ShapeRange.Height = 21
    End With
    
    With ActiveSheet.Shapes("CommandButton5")
        .ShapeRange.Left = 460
        .ShapeRange.Top = 0
        .ShapeRange.Width = 150
        .ShapeRange.Height = 21
    End With
    
    With ActiveSheet.Shapes("CommandButton6")
        .ShapeRange.Left = 620
        .ShapeRange.Top = 0
        .ShapeRange.Width = 150
        .ShapeRange.Height = 21
    End With
    
    With ActiveSheet.Shapes("CommandButton7")
        .ShapeRange.Left = 820
        .ShapeRange.Top = 0
        .ShapeRange.Width = 10
        .ShapeRange.Height = 10
    End With
        
    Sheets("Connector pin list").AutoFilter
    
    CommandButton3.Enabled = False

End Sub
 
Upvote 0
thanks Norie

I will clean up my code with those changes.

The part of the code that is taking all the time is getting the data from sheet3 (Wire List Data) and putting it in sheet6

It does this 2 times, the first time is the data FROM - TO and the second is TO - FROM.

I then end up with a complete list of every pin used on every connector.
 
Upvote 0
Could you give some more explanantion of the loops, which I assume is the area causing the problem?
 
Upvote 0
In sheet 3 where all the data is input, we would fill in on each row a wire code, the connection at one end of the wire, the connection at the other end of the wire plus some other data.
To enable me to get a listing of every connection I get all the data with the cable from information at the begining and then at the end of that I do the same again putting the from adat in the first column.

Hope that makes sense?
 
Upvote 0
anywhere you reference an object more than once, use a With/End With to save time.

so change this:

Sheet6.Cells(nlin - 1, 1) = txt2
Sheet6.Cells(nlin - 1, 2) = txt1
Sheet6.Cells(nlin - 1, 3) = txt3
Sheet6.Cells(nlin - 1, 4) = txt4
Sheet6.Cells(nlin - 1, 5) = txt5
Sheet6.Cells(nlin - 1, 6) = txt6
Sheet6.Cells(nlin - 1, 7) = txt7
Sheet6.Cells(nlin - 1, 9) = txt9
Sheet6.Cells(nlin - 1, 10) = txt10
Sheet6.Cells(nlin - 1, 11) = Txt11

to this:

With Sheet6
.Cells(nlin - 1, 1) = txt2
.Cells(nlin - 1, 2) = txt1
.Cells(nlin - 1, 3) = txt3
etc
etc
end With
 
Upvote 0
You must log in or register to reply here.

Similar threads

B
  • Solved
Recording macro pivot table error
Replies
2
Views
994
biglb79
B
M
  • Solved
How to make VBA code faster
Replies
7
Views
655
johnnyL
J
A
  • Solved
Changing recorded macro to have dynamic selection of cells when trying to format a sheet.
Replies
4
Views
600
Michael M
Michael M
A
  • Solved
THIS IS MY CODE HOW DO I MAKE IT SO IT ONLY RUNS ON THE INPUT TAB SO I DONT MESS UP THE WRONG TAB
Replies
9
Views
398
My Aswer Is This
My Aswer Is This
M
  • Question
How to Make this Macro work Fast?
Replies
2
Views
344
Georgiboy
Georgiboy

Forum statistics

Threads
1,214,827
Messages
6,121,806
Members
449,048
Latest member
greyangel23

Share this page

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
Back
Top