Slow and Hungry Code

[test3xc31]

Okay so I've been learning as I go, the below code all works fine... as long as you have a powerful machine to run it and plently of time. Does anyone have any suggestions as to how I can make it more efficent and faster?

Sub Printdata()

Dim Passport As Worksheet
Dim Tally As Worksheet
Dim Loads As Worksheet
Dim AnnualData As Worksheet
Dim FixedData As Worksheet
Set Passport = Sheets("Passport")
Set Tally = Sheets("Tally")
Set Loads = Sheets("Loads")
Set AnnualData = Sheets("Annualdata")
Set FixedData = Sheets("FixedData")

Passport.Range("Loadingdate").Calculate

If Passport.Range("Merchant").Value = "" Then
            ActiveSheet.Range("Merchant").Select
            MsgBox "Please enter a Merchant"
            Exit Sub
End If

If Passport.Range("Destination").Value = "" Then
            ActiveSheet.Range("destination").Select
            MsgBox "Please enter a Destination"
            Exit Sub
End If

If Passport.Range("Haulier").Value = "" Then
            ActiveSheet.Range("Haulier").Select
            MsgBox "Please Enter a Haulier"
            Exit Sub
End If

If Passport.Range("Vehiclereg").Value = "" Then
            ActiveSheet.Range("Vehiclereg").Select
            MsgBox "Please enter a Vehicle Registration"
            Exit Sub
End If

If Passport.Range("Trailerid").Value = "" Then
            ActiveSheet.Range("Trailerid").Select
            MsgBox "Please enter a Trailer ID"
            Exit Sub
End If

If Passport.Range("Collectionticket").Value = "" Then
            ActiveSheet.Range("Collectionticket").Select
            MsgBox "Please enter a Ticket Number"
            Exit Sub
End If

If Passport.Range("product1st").Value = "" Then
            ActiveSheet.Range("product1st").Select
            MsgBox "Please enter 1st load in section 2"
            Exit Sub
End If

If Passport.Range("product2nd").Value = "" Then
            ActiveSheet.Range("product2nd").Select
            MsgBox "Please enter 2nd load in section 2"
            Exit Sub
End If

If Passport.Range("product3rd").Value = "" Then
            ActiveSheet.Range("product3rd").Select
            MsgBox "Please enter 3rd load in section 2"
            Exit Sub
End If

If Passport.Range("clean1st").Value = "" Then
            ActiveSheet.Range("clean1st").Select
            MsgBox "Please enter 1st load cleaning detail in section 2"
            Exit Sub
End If

If Passport.Range("clean2nd").Value = "" Then
            ActiveSheet.Range("clean2nd").Select
            MsgBox "Please enter 2nd load cleaning detail in section 2"
            Exit Sub
End If

If Passport.Range("clean3rd").Value = "" Then
            ActiveSheet.Range("clean3rd").Select
            MsgBox "Please enter 3rd load cleaning detail in section 2"
            Exit Sub
End If

response = MsgBox("IMPORTANT NOTICE" & vbCrLf & " " & vbCrLf & "Are you sure you want to print and save?" & vbCrLf & " " & vbCrLf & "Have you Checked:" & vbCrLf & "   - Store (Section 1)" & vbCrLf & "   - Grower/Storekeeper Name (Section 6)" & vbCrLf & "   - Tonnage (part loads only) (Section 1)", vbYesNo)

If response = vbNo Then
    MsgBox ("Finish and Print Cancelled")
    Exit Sub
End If

Application.ScreenUpdating = False

UserForm3.Show

If Sheets("Fixeddata").CheckBoxes("Check Box 3").Value = 1 Then
SyncFromDB
Passport.Activate
End If

Application.EnableEvents = False

Passport.Unprotect
If Passport.CheckBoxes("check box 36").Value = Checked Then
Application.Goto Reference:="Passportprintarea"
Selection.PrintOut Copies:=Range("AN10"), Collate:=False ', IgnorePrintAreas:=False

End If

Loads.Unprotect
Tally.Unprotect

Set p = Passport.Range("Passportdata")
Set v = Tally.Range("Tvariety")
Set y = Tally.Range("Tyear")
Set destp = Tally.Range("A" & Tally.Rows.Count).End(xlUp).Offset(1)
Set destv = Loads.Range("W2")
Set desty = Loads.Range("V2")
v.Copy
destv.PasteSpecial Paste:=xlPasteValues
y.Copy
desty.PasteSpecial Paste:=xlPasteValues
p.Copy
destp.PasteSpecial Paste:=xlPasteValues
Loads.Range("W:W").RemoveDuplicates Columns:=1, Header:=xlYes
Loads.Range("V:V").RemoveDuplicates Columns:=1, Header:=xlYes

Checkbox

With Passport
    .Range("changingdata").ClearContents
    .Range("V15:AB15").FormulaR1C1 = "BRUSH/VACUUM"
    .Range("V16:AB16").FormulaR1C1 = "BRUSH/VACUUM"
    .Range("V17:AB17").FormulaR1C1 = "BRUSH/VACUUM"
    .Protect
End With

If Sheets("Fixeddata").CheckBoxes("Check Box 3").Value = 1 Then
Tally.Range("lastlocalchange").Value = Now
SyncToDB
End If

Tally.Protect
Loads.Protect

Save

Application.EnableEvents = True
Passport.Activate
ActiveSheet.Range("p5").Select
Application.ScreenUpdating = True

End Sub

Sub Save()
Application.DisplayAlerts = False
OrigName = ActiveWorkbook.FullName

  Dim SaveName As String
  Dim SaveLocation As String
    If Sheets("fixeddata").CheckBoxes("Check box 1").Value = 1 Then
     On Error GoTo selectfolder
            SaveName = Sheets("passport").Range("Filenamebackup").Text
       SaveLocation = Sheets("passport").Range("Filelocationbackup").Text
       ActiveWorkbook.SaveAs FileName:=SaveLocation & "\" & SaveName & ".xlsm", CreateBackup:=False
   End If
       ActiveWorkbook.SaveAs OrigName, CreateBackup:=False
Application.DisplayAlerts = True
Exit Sub
selectfolder:
MsgBox "Please select backup folder location"
Browseforfolder
End Sub

Sub Checkbox()
Dim Passport
Set Passport = Sheets("Passport")
If Passport.CheckBoxes("Check Box 25").Value = 1 Then
Passport.CheckBoxes("Check Box 25").Value = 0
    Passport.Unprotect
        Passport.Range("f5:J5").FormulaR1C1 = "=IFERROR(IF(Variety="""",""SELECT STORE"",IF(VLOOKUP(Variety,AnnualData!R[4]C[-4]:R[10]C[2],4,FALSE)="""",""UNSPECIFIED"",UPPER(VLOOKUP(Variety,AnnualData!R[4]C[-4]:R[10]C[2],4,FALSE)))),"""")"
        Passport.Range("F5:J5").Locked = True
        Passport.Protect
        End If
End Sub

 

[yky]

Add the following code to the beginning of your code and, at the end of your code, reverse them by setting them to either True or xlCalculationAutomatic.

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

 

[test3xc31]

Add the following code to the beginning of your code and, at the end of your code, reverse them by setting them to either True or xlCalculationAutomatic.

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

Thankyou, that has definatly helped.