f2e4
07-04-2008, 04:51 AM
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
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