Loss1003
02-29-2016, 12:32 PM
I've got an excel sheet and userform1 that stores up to approx 100 columns of data. The speed was working fine up until approx 4,000 rows of data are entered. The form then takes quadruple the time to load, retrieving data, moving to the next row, saving, deleting. etc.
Perhaps someone can share a few pointers on how to speed the following Get Data code up.
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
Dim R As Long
lastrow = FindLastRow + 1
If IsNumeric(RowNumber.Text) Then
R = CLng(RowNumber.Text)
Else
Cleardata
MsgBox "Illegal Row Number"
Exit Sub
End If
If Sheet2.Cells(R, 25).Value = "X" Then
General.Value = True
End If
If Sheet2.Cells(R, 26).Value = "X" Then
Onsite.Value = True
End If
If Sheet2.Cells(R, 27).Value = "X" Then
Phone.Value = True
End If
If Sheet2.Cells(R, 28).Value = "X" Then
Desktop.Value = True
End If
If Sheet2.Cells(R, 29).Value = "X" Then
Switch1.Value = True
End If
If Sheet2.Cells(R, 30).Value = "X" Then
Unprod.Value = True
End If
If Sheet2.Cells(R, 31).Value = "X" Then
Canreq.Value = True
End If
If Sheet2.Cells(R, 32).Value = "X" Then
Canlc.Value = True
End If
If Sheet2.Cells(R, 33).Value = "X" Then
Reassign.Value = True
End If
If Sheet2.Cells(R, 34).Value = "X" Then
Otherscope.Value = True
OtherscopeN.Visible = True
End If
If Sheet2.Cells(R, 52).Value = "X" Then
QQip.Value = True
QQc.Value = False
End If
If Sheet2.Cells(R, 53).Value = "X" Then
QQip.Value = False
QQc.Value = True
End If
If Sheet2.Cells(R, 52).Value = "" And Sheet2.Cells(R, 53).Value = "" Then
QQip.Value = False
QQc.Value = False
End If
If Sheet2.Cells(R, 91).Value = "" Then
Rprop.Value = False
Else
Rprop.Value = True
End If
If Sheet2.Cells(R, 92).Value = "" Then
Rcas.Value = False
Else
Rcas.Value = True
End If
If Sheet2.Cells(R, 93).Value = "" Then
Renv.Value = False
Else
Renv.Value = True
End If
If Sheet2.Cells(R, 94).Value = "" Then
Rauto.Value = False
Else
Rauto.Value = True
End If
If Sheet2.Cells(R, 95).Value = "" Then
Rspecial.Value = False
Else
Rspecial.Value = True
End If
If Sheet2.Cells(R, 96).Value = "" Then
Rother.Value = False
Else
Rother.Value = True
End If
If Sheet2.Cells(R, 102).Value = "Yes" Then
Ryes1.Value = True
Rno1.Value = False
Else
Ryes1.Value = False
Rno1.Value = True
End If
If R > 1 And R <= lastrow Then
UserForm1.Acname1.Value = Cells(R, 1).Value
UserForm1.LCfile.Value = Cells(R, 2).Value
UserForm1.Abbrv1.Value = Cells(R, 3).Value
UserForm1.Year1.Value = Cells(R, 4).Value
UserForm1.Pol1.Value = Cells(R, 5).Value
UserForm1.Sub1.Value = Cells(R, 6).Value
UserForm1.Loc1.Value = Cells(R, 7).Value
UserForm1.Dept1.Value = Cells(R, 8).Value
UserForm1.enter1.Value = Cells(R, 9).Value
UserForm1.Month1.Value = Cells(R, 10).Value
UserForm1.Order1.Value = Cells(R, 11).Value
UserForm1.Due1.Value = Cells(R, 12).Value
UserForm1.Extend1.Value = Cells(R, 13).Value
UserForm1.Extend2.Value = Cells(R, 14).Value
UserForm1.Date1.Value = Cells(R, 15).Value
UserForm1.Date2.Value = Cells(R, 16).Value
UserForm1.Req1.Value = Cells(R, 17).Value
UserForm1.Req2.Value = Cells(R, 18).Value
UserForm1.Req3.Value = Cells(R, 19).Value
Req3.Value = Format(Req3, "00")
UserForm1.State1.Value = Cells(R, 20).Value
UserForm1.Vendor1.Value = Cells(R, 21).Value
UserForm1.Status1.Value = Cells(R, 22).Value
UserForm1.Budget1.Value = Cells(R, 23).Value
UserForm1.Budget2.Value = Cells(R, 24).Value
Budget2.Value = Format(Budget2, "$#,##0.00")
UserForm1.OtherscopeN.Value = Cells(R, 35).Value
UserForm1.Notes1.Value = Cells(R, 36).Value
UserForm1.Recstatus.Value = Cells(R, 37).Value
UserForm1.RecCompDate.Value = Cells(R, 38).Value
UserForm1.RepRecs.Value = Cells(R, 39).Value
UserForm1.recletter.Value = Cells(R, 40).Value
UserForm1.Openrecs.Value = Cells(R, 41).Value
UserForm1.Complied1.Value = Cells(R, 42).Value
UserForm1.Ncrec1.Value = Cells(R, 43).Value
UserForm1.Ncrec2.Value = Cells(R, 44).Value
UserForm1.Ncrec3.Value = Cells(R, 45).Value
UserForm1.Absent1.Value = Cells(R, 46).Value
UserForm1.Totalrec1.Value = Cells(R, 47).Value
UserForm1.Perc1.Value = Cells(R, 48).Value
UserForm1.Perc2.Value = Cells(R, 49).Value
UserForm1.Perc3.Value = Cells(R, 50).Value
UserForm1.Perc4.Value = Cells(R, 51).Value
' UserForm1.QQip.Value = Cells(r, 52).Value
' UserForm1.QQc.Value = Cells(r, 53).Value
UserForm1.Days1.Value = Cells(R, 54).Value
UserForm1.Days3.Value = Cells(R, 55).Value
UserForm1.Days4.Value = Cells(R, 56).Value
UserForm1.Days2.Value = Cells(R, 57).Value
If Extend2.Value > 0 Then
Label54.Caption = "Yes"
Else
Label54.Caption = "No"
End If
UserForm1.RCorpAdd.Value = Cells(R, 58).Value
UserForm1.Rorder.Value = Cells(R, 59).Value
UserForm1.RDue.Value = Cells(R, 60).Value
UserForm1.Rreqn1.Value = Cells(R, 61).Value
UserForm1.Rreqn2.Value = Cells(R, 62).Value
UserForm1.Rrloc.Value = Cells(R, 63).Value
UserForm1.Rrphone.Value = Cells(R, 64).Value
Rrphone.Value = Format(Rrphone, "(###) ###-####")
UserForm1.Rregc.Value = Cells(R, 65).Value
Rregc.Value = Format(Rregc, "00")
UserForm1.Rrem.Value = Cells(R, 66).Value
UserForm1.Ruwn1.Value = Cells(R, 67).Value
UserForm1.Ruwn2.Value = Cells(R, 68).Value
UserForm1.RuwLoc.Value = Cells(R, 69).Value
UserForm1.Ruwp.Value = Cells(R, 70).Value
Ruwp.Value = Format(Ruwp, "(###) ###-####")
UserForm1.Ruwrc.Value = Cells(R, 71).Value
Ruwrc.Value = Format(Ruwrc, "00")
UserForm1.Ruwem.Value = Cells(R, 72).Value
UserForm1.Rwhole.Value = Cells(R, 73).Value
UserForm1.Rwname1.Value = Cells(R, 74).Value
UserForm1.Rwname2.Value = Cells(R, 75).Value
UserForm1.Rwadd1.Value = Cells(R, 76).Value
UserForm1.Rwadd2.Value = Cells(R, 77).Value
UserForm1.Rwadd3.Value = Cells(R, 78).Value
UserForm1.Rwadd4.Value = Cells(R, 79).Value
Rwadd4.Value = Format(Rwadd4, "00000")
UserForm1.Rwphone.Value = Cells(R, 80).Value
Rwphone.Value = Format(Rwphone, "(###) ###-####")
UserForm1.Rwem.Value = Cells(R, 81).Value
UserForm1.Rretail.Value = Cells(R, 82).Value
UserForm1.Rrwname1.Value = Cells(R, 83).Value
UserForm1.Rrwname2.Value = Cells(R, 84).Value
UserForm1.Rradd1.Value = Cells(R, 85).Value
UserForm1.Rradd2.Value = Cells(R, 86).Value
UserForm1.Rradd3.Value = Cells(R, 87).Value
UserForm1.Rradd4.Value = Cells(R, 88).Value
Rradd4.Value = Format(Rradd4, "00000")
UserForm1.Rrbphone.Value = Cells(R, 89).Value
Rrbphone.Value = Format(Rrbphone, "(###) ###-####")
UserForm1.Rrbem.Value = Cells(R, 90).Value
UserForm1.Rprops.Value = Cells(R, 91).Value
UserForm1.Rcass.Value = Cells(R, 92).Value
UserForm1.Renvs.Value = Cells(R, 93).Value
UserForm1.Rautos.Value = Cells(R, 94).Value
UserForm1.Rspecials.Value = Cells(R, 95).Value
UserForm1.Rothers.Value = Cells(R, 96).Value
UserForm1.Rnature.Value = Cells(R, 97).Value
UserForm1.RLoc.Value = Cells(R, 98).Value
UserForm1.Rcontact.Value = Cells(R, 99).Value
UserForm1.RContactp.Value = Cells(R, 100).Value
RContactp.Value = Format(RContactp, "(###) ###-####")
UserForm1.RspecialI.Value = Cells(R, 101).Value
UserForm1.RBLevel1.Value = Cells(R, 103).Value
UserForm1.RBLevel2.Value = Cells(R, 104).Value
UserForm1.LCfile.Value = RowNumber.Text - 1
ElseIf R = 1 Then
Cleardata
Else
Cleardata
MsgBox "Invalid Row Numer"
End If
With Application
.ScreenUpdating = True
.Calculation = xlCalculationManual
.EnableEvents = True
End With
Perhaps someone can share a few pointers on how to speed the following Get Data code up.
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
Dim R As Long
lastrow = FindLastRow + 1
If IsNumeric(RowNumber.Text) Then
R = CLng(RowNumber.Text)
Else
Cleardata
MsgBox "Illegal Row Number"
Exit Sub
End If
If Sheet2.Cells(R, 25).Value = "X" Then
General.Value = True
End If
If Sheet2.Cells(R, 26).Value = "X" Then
Onsite.Value = True
End If
If Sheet2.Cells(R, 27).Value = "X" Then
Phone.Value = True
End If
If Sheet2.Cells(R, 28).Value = "X" Then
Desktop.Value = True
End If
If Sheet2.Cells(R, 29).Value = "X" Then
Switch1.Value = True
End If
If Sheet2.Cells(R, 30).Value = "X" Then
Unprod.Value = True
End If
If Sheet2.Cells(R, 31).Value = "X" Then
Canreq.Value = True
End If
If Sheet2.Cells(R, 32).Value = "X" Then
Canlc.Value = True
End If
If Sheet2.Cells(R, 33).Value = "X" Then
Reassign.Value = True
End If
If Sheet2.Cells(R, 34).Value = "X" Then
Otherscope.Value = True
OtherscopeN.Visible = True
End If
If Sheet2.Cells(R, 52).Value = "X" Then
QQip.Value = True
QQc.Value = False
End If
If Sheet2.Cells(R, 53).Value = "X" Then
QQip.Value = False
QQc.Value = True
End If
If Sheet2.Cells(R, 52).Value = "" And Sheet2.Cells(R, 53).Value = "" Then
QQip.Value = False
QQc.Value = False
End If
If Sheet2.Cells(R, 91).Value = "" Then
Rprop.Value = False
Else
Rprop.Value = True
End If
If Sheet2.Cells(R, 92).Value = "" Then
Rcas.Value = False
Else
Rcas.Value = True
End If
If Sheet2.Cells(R, 93).Value = "" Then
Renv.Value = False
Else
Renv.Value = True
End If
If Sheet2.Cells(R, 94).Value = "" Then
Rauto.Value = False
Else
Rauto.Value = True
End If
If Sheet2.Cells(R, 95).Value = "" Then
Rspecial.Value = False
Else
Rspecial.Value = True
End If
If Sheet2.Cells(R, 96).Value = "" Then
Rother.Value = False
Else
Rother.Value = True
End If
If Sheet2.Cells(R, 102).Value = "Yes" Then
Ryes1.Value = True
Rno1.Value = False
Else
Ryes1.Value = False
Rno1.Value = True
End If
If R > 1 And R <= lastrow Then
UserForm1.Acname1.Value = Cells(R, 1).Value
UserForm1.LCfile.Value = Cells(R, 2).Value
UserForm1.Abbrv1.Value = Cells(R, 3).Value
UserForm1.Year1.Value = Cells(R, 4).Value
UserForm1.Pol1.Value = Cells(R, 5).Value
UserForm1.Sub1.Value = Cells(R, 6).Value
UserForm1.Loc1.Value = Cells(R, 7).Value
UserForm1.Dept1.Value = Cells(R, 8).Value
UserForm1.enter1.Value = Cells(R, 9).Value
UserForm1.Month1.Value = Cells(R, 10).Value
UserForm1.Order1.Value = Cells(R, 11).Value
UserForm1.Due1.Value = Cells(R, 12).Value
UserForm1.Extend1.Value = Cells(R, 13).Value
UserForm1.Extend2.Value = Cells(R, 14).Value
UserForm1.Date1.Value = Cells(R, 15).Value
UserForm1.Date2.Value = Cells(R, 16).Value
UserForm1.Req1.Value = Cells(R, 17).Value
UserForm1.Req2.Value = Cells(R, 18).Value
UserForm1.Req3.Value = Cells(R, 19).Value
Req3.Value = Format(Req3, "00")
UserForm1.State1.Value = Cells(R, 20).Value
UserForm1.Vendor1.Value = Cells(R, 21).Value
UserForm1.Status1.Value = Cells(R, 22).Value
UserForm1.Budget1.Value = Cells(R, 23).Value
UserForm1.Budget2.Value = Cells(R, 24).Value
Budget2.Value = Format(Budget2, "$#,##0.00")
UserForm1.OtherscopeN.Value = Cells(R, 35).Value
UserForm1.Notes1.Value = Cells(R, 36).Value
UserForm1.Recstatus.Value = Cells(R, 37).Value
UserForm1.RecCompDate.Value = Cells(R, 38).Value
UserForm1.RepRecs.Value = Cells(R, 39).Value
UserForm1.recletter.Value = Cells(R, 40).Value
UserForm1.Openrecs.Value = Cells(R, 41).Value
UserForm1.Complied1.Value = Cells(R, 42).Value
UserForm1.Ncrec1.Value = Cells(R, 43).Value
UserForm1.Ncrec2.Value = Cells(R, 44).Value
UserForm1.Ncrec3.Value = Cells(R, 45).Value
UserForm1.Absent1.Value = Cells(R, 46).Value
UserForm1.Totalrec1.Value = Cells(R, 47).Value
UserForm1.Perc1.Value = Cells(R, 48).Value
UserForm1.Perc2.Value = Cells(R, 49).Value
UserForm1.Perc3.Value = Cells(R, 50).Value
UserForm1.Perc4.Value = Cells(R, 51).Value
' UserForm1.QQip.Value = Cells(r, 52).Value
' UserForm1.QQc.Value = Cells(r, 53).Value
UserForm1.Days1.Value = Cells(R, 54).Value
UserForm1.Days3.Value = Cells(R, 55).Value
UserForm1.Days4.Value = Cells(R, 56).Value
UserForm1.Days2.Value = Cells(R, 57).Value
If Extend2.Value > 0 Then
Label54.Caption = "Yes"
Else
Label54.Caption = "No"
End If
UserForm1.RCorpAdd.Value = Cells(R, 58).Value
UserForm1.Rorder.Value = Cells(R, 59).Value
UserForm1.RDue.Value = Cells(R, 60).Value
UserForm1.Rreqn1.Value = Cells(R, 61).Value
UserForm1.Rreqn2.Value = Cells(R, 62).Value
UserForm1.Rrloc.Value = Cells(R, 63).Value
UserForm1.Rrphone.Value = Cells(R, 64).Value
Rrphone.Value = Format(Rrphone, "(###) ###-####")
UserForm1.Rregc.Value = Cells(R, 65).Value
Rregc.Value = Format(Rregc, "00")
UserForm1.Rrem.Value = Cells(R, 66).Value
UserForm1.Ruwn1.Value = Cells(R, 67).Value
UserForm1.Ruwn2.Value = Cells(R, 68).Value
UserForm1.RuwLoc.Value = Cells(R, 69).Value
UserForm1.Ruwp.Value = Cells(R, 70).Value
Ruwp.Value = Format(Ruwp, "(###) ###-####")
UserForm1.Ruwrc.Value = Cells(R, 71).Value
Ruwrc.Value = Format(Ruwrc, "00")
UserForm1.Ruwem.Value = Cells(R, 72).Value
UserForm1.Rwhole.Value = Cells(R, 73).Value
UserForm1.Rwname1.Value = Cells(R, 74).Value
UserForm1.Rwname2.Value = Cells(R, 75).Value
UserForm1.Rwadd1.Value = Cells(R, 76).Value
UserForm1.Rwadd2.Value = Cells(R, 77).Value
UserForm1.Rwadd3.Value = Cells(R, 78).Value
UserForm1.Rwadd4.Value = Cells(R, 79).Value
Rwadd4.Value = Format(Rwadd4, "00000")
UserForm1.Rwphone.Value = Cells(R, 80).Value
Rwphone.Value = Format(Rwphone, "(###) ###-####")
UserForm1.Rwem.Value = Cells(R, 81).Value
UserForm1.Rretail.Value = Cells(R, 82).Value
UserForm1.Rrwname1.Value = Cells(R, 83).Value
UserForm1.Rrwname2.Value = Cells(R, 84).Value
UserForm1.Rradd1.Value = Cells(R, 85).Value
UserForm1.Rradd2.Value = Cells(R, 86).Value
UserForm1.Rradd3.Value = Cells(R, 87).Value
UserForm1.Rradd4.Value = Cells(R, 88).Value
Rradd4.Value = Format(Rradd4, "00000")
UserForm1.Rrbphone.Value = Cells(R, 89).Value
Rrbphone.Value = Format(Rrbphone, "(###) ###-####")
UserForm1.Rrbem.Value = Cells(R, 90).Value
UserForm1.Rprops.Value = Cells(R, 91).Value
UserForm1.Rcass.Value = Cells(R, 92).Value
UserForm1.Renvs.Value = Cells(R, 93).Value
UserForm1.Rautos.Value = Cells(R, 94).Value
UserForm1.Rspecials.Value = Cells(R, 95).Value
UserForm1.Rothers.Value = Cells(R, 96).Value
UserForm1.Rnature.Value = Cells(R, 97).Value
UserForm1.RLoc.Value = Cells(R, 98).Value
UserForm1.Rcontact.Value = Cells(R, 99).Value
UserForm1.RContactp.Value = Cells(R, 100).Value
RContactp.Value = Format(RContactp, "(###) ###-####")
UserForm1.RspecialI.Value = Cells(R, 101).Value
UserForm1.RBLevel1.Value = Cells(R, 103).Value
UserForm1.RBLevel2.Value = Cells(R, 104).Value
UserForm1.LCfile.Value = RowNumber.Text - 1
ElseIf R = 1 Then
Cleardata
Else
Cleardata
MsgBox "Invalid Row Numer"
End If
With Application
.ScreenUpdating = True
.Calculation = xlCalculationManual
.EnableEvents = True
End With