Solved: Ideas to make this code faster

[f2e4]

Hey guys,

At the minute, this code takes approx 30-45 seconds to run and i'm fairly sure that's all down to the stupidly slow loops i've put in.

Has anyone got any ideas on speeding this up?

Sub Add_Member_to_Project()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationAutomatic

'STORE VALUES ENTERED
staffdropdown = ActiveSheet.ComboBox11.Value
projectdropdown = ActiveSheet.ComboBox12.Value

'CHECK TO SEE IF ALL FIELDS HAVE BEEN ENTERED
If ActiveSheet.ComboBox11.Value = Null Or ActiveSheet.ComboBox11.Value = "" Or _
ActiveSheet.ComboBox12.Value = Null Or ActiveSheet.ComboBox12.Value = "" Then
response = MsgBox(prompt:="Please ensure that all fields are populated", _
Buttons:=vbOK, Title:="Error") = vbOK
Exit Sub
End If
'FIND STAFF DETAILS IN STAFF LIST
Sheets("Staff List").Select
x = 3
Do
x = x + 1
Loop Until Cells(x, 3) = staffdropdown
staffnumber = Cells(x, 2)
staffname = Cells(x, 4)
stafflocation = Cells(x, 6)

'FIND PROJECT DETAILS IN PROJECT LIST
Sheets("Projects").Select
y = 3
Do
y = y + 1
Loop Until Cells(y, 8) = projectdropdown
projnum = Cells(y, 2)
projname = Cells(y, 3)
projsect = Cells(y, 4)
projman = Cells(y, 5)
projstat = Cells(y, 6)

Sheets("Workload").Select
'FIND FIRST EMPTY ROW
Dim NextRow As Long
With ActiveSheet
NextRow = .Cells(.Rows.Count, "C").End(xlUp).Row + 1
End With
Dim NameJoin As String
NameJoin = staffdropdown & "," & " " & staffname
'INPUT STORED DATA
Cells(NextRow, 2) = projnum
Cells(NextRow, 3) = projname
Cells(NextRow, 4) = projsect
Cells(NextRow, 5) = projman
Cells(NextRow, 6) = projstat
Cells(NextRow, 7) = NameJoin
Cells(NextRow, 8) = stafflocation
'SORT WORKLOAD SHEET BY CATEGORY THEN BY PROJECT NAME
Range("B4:EZ4").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Sort Key1:=Range("F4"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, Key2:=Range("C4"), Order2:=xlAscending, Header:=xlGuess, _
OrderCustom:=2, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption2:=xlSortNormal
Range("A1").Select
Sheets("Editing").Select
'CONFIRMATION MESSAGE
If MsgBox(prompt:="A staff member has successfully been added to a project on the Workload sheet",_
Buttons:=vbOK, Title:="Operation Complete") = vbOK Then
End If
Application.ScreenUpdating = True

End Sub

Thanks in advance

[Dave]

Trial this @ the start...
Application.Calculation = xlCalculationManual
Then this @ the end...

Application.Calculation = xlCalculationAutomatic

HTH. Dave

[mdmackillop]

Use Find to locate data intead of loops

x = Columns(3).Find(staffdropdown, after:=Cells(1, 3)).Row



Don't select your ranges

Range(Range("B4:EZ4"), Range("B4:EZ4").End(xlDown)).Sort Key1:=Range("F4"), _
Order1:=xlAscending, Header:=xlGuess, _

[f2e4]

Both of these ideas worked perfectly

Now it only takes about 1 second to run

Thanks a lot guys