Excel lagging b/c code?

[Megan_NRC]

My Excel Workbook is LAGGING! I believe it is due to my code being so long/tedious. I'm pretty new at VBA, I took a course in college about 6 years ago and I haven't had to use that knowledge since recent and it's not coming back to me as quickly as I hoped.
I'm hoping that there is some kind of "looping" that can take place of all the tedious lines...

I've created a form that supervisors enter project information and then it populates the correct cells in a main project tracker.


Here is my code:

Private Sub btn_Update_Click()
Dim myDate As Date
Dim myNote As String
Dim myDept As Variant
Dim myNRC As Variant
Dim find As Range
Dim myQC As Variant
Dim mystatus As Variant




myDate = TB_Date.Value
myDept = LB_Dept.Value
myNRC = tb_NRCNum.Value
myNote = lb_Complete.Value
myQC = LB_QC.Value
mystatus = LB_status.Value






Set find = Cells.find(What:=myNRC, LookAt:=xlWhole, after:=Range("A65536"))
If find Is Nothing Then
MsgBox "NRC IS NOT VALID!"
ElseIf Not find Is Nothing Then
Cells.find(What:=myNRC, LookAt:=xlWhole, after:=Range("A65536")).Activate




If myDept = "Aerial" Then
ActiveCell.Offset(0, 4).Activate
ActiveCell.Value = myDate
Selection.NumberFormat = "m/d/yy"
ActiveCell.Offset(0, 1).Activate
ActiveCell.Value = myNote
ActiveCell.Offset(0, 10).Activate
ActiveCell.Value = myQC
ActiveCell.Offset(0, 2).Activate
ActiveCell.Value = mystatus


ElseIf myDept = "Underground" Then
ActiveCell.Offset(0, 6).Activate
ActiveCell.Value = myDate
Selection.NumberFormat = "m/d/yy"
ActiveCell.Offset(0, 1).Activate
ActiveCell.Value = myNote
ActiveCell.Offset(0, 8).Activate
ActiveCell.Value = myQC
ActiveCell.Offset(0, 2).Activate
ActiveCell.Value = mystatus


ElseIf myDept = "Coax" Then
ActiveCell.Offset(0, 8).Activate
ActiveCell.Value = myDate
Selection.NumberFormat = "m/d/yy"
ActiveCell.Offset(0, 1).Activate
ActiveCell.Value = myNote
ActiveCell.Offset(0, 6).Activate
ActiveCell.Value = myQC
ActiveCell.Offset(0, 2).Activate
ActiveCell.Value = mystatus


ElseIf myDept = "MDU" Then
ActiveCell.Offset(0, 10).Activate
ActiveCell.Value = myDate
Selection.NumberFormat = "m/d/yy"
ActiveCell.Offset(0, 1).Activate
ActiveCell.Value = myNote
ActiveCell.Offset(0, 4).Activate
ActiveCell.Value = myQC
ActiveCell.Offset(0, 2).Activate
ActiveCell.Value = mystatus


ElseIf myDept = "Fiber" Then
ActiveCell.Offset(0, 12).Activate
ActiveCell.Value = myDate
Selection.NumberFormat = "m/d/yy"
ActiveCell.Offset(0, 1).Activate
ActiveCell.Value = myNote
ActiveCell.Offset(0, 2).Activate
ActiveCell.Value = myQC
ActiveCell.Offset(0, 2).Activate
ActiveCell.Value = mystatus


End If
End If
End Sub

 

[Norie]

The only problem I can see with that code is all the Activate/ActiveCell stuff, that's just not needed.

Try this.

Private Sub btn_Update_Click()
Dim myDate As Date
Dim myNote As String
Dim myDept As Variant
Dim myNRC As Variant
Dim find As Range
Dim myQC As Variant
Dim mystatus As Variant

    myDate = TB_Date.Value
    myDept = LB_Dept.Value
    myNRC = tb_NRCNum.Value
    myNote = lb_Complete.Value
    myQC = LB_QC.Value
    mystatus = LB_status.Value

    Set find = Cells.find(What:=myNRC, LookAt:=xlWhole, after:=Range("A65536"))

    If find Is Nothing Then
        MsgBox "NRC IS NOT VALID!"
    Else
    
        With find
        
            If myDept = "Aerial" Then
                .Offset(0, 4).Value = myDate
                .Offset(0, 4).NumberFormat = "m/d/yy"
                .Offset(0, 5).Value = myNote
                .Offset(0, 15).Value = myQC
                .Offset(0, 17).Value = mystatus

            ElseIf myDept = "Underground" Then
                .Offset(0, 6).Value = myDate
                .Offset(0, 6).NumberFormat = "m/d/yy"
                .Offset(0, 7).Value = myNote
                .Offset(0, 15).Value = myQC
                .Offset(0, 17).Value = mystatus

            ElseIf myDept = "Coax" Then
                .Offset(0, 8).Value = myDate
                .Offset(0, 8).NumberFormat = "m/d/yy"
                .Offset(0, 9).Value = myNote
                .Offset(0, 15).Value = myQC
                .Offset(0, 17).Value = mystatus

            ElseIf myDept = "MDU" Then
                .Offset(0, 10).Value = myDate
                .Offset(0, 10).NumberFormat = "m/d/yy"
                .Offset(0, 11).Value = myNote
                .Offset(0, 15).Value = myQC
                .Offset(0, 17).Value = mystatus

            ElseIf myDept = "Fiber" Then
                .Offset(0, 12).Value = myDate
                .Offset(0, 12).NumberFormat = "m/d/yy"
                .Offset(0, 13).Value = myNote
                .Offset(0, 15).Value = myQC
                .Offset(0, 17).Value = mystatus
            End If
            
        End With
        
    End If

 

[Megan_NRC]

Thank you so much!!! That cleaned up my code ALOT, however, it is still REALLY lagging. I'm afraid of it crashing when "happy clicking" people are trying to update...I have some conditional formatting on the worksheet, could that be my problem?

 

[Norie]

It could be a number of other things that are slowing things up.

Do you have any other code in the workbook?

Do you have a lot of formulas?

Do you have formulas that use whole column/row references?

What conditional formatting do you have and how many cells is it applied to?

 

[Megan_NRC]

I have another code(see below) to move rows from one worksheet to another. The people using this workbook as COMPLETELY EXCEL UNFRIENDLY, so it's necessary to make things as automated as possible.
I have zero formulas.
I have conditional formatting that applies to entire columns...is it possible to set a conditional formula to go to just the last row versus to row 9415643478567 (haha)
Would it be better to add my "conditional formatting" into my code?
Example of a condition I have set:
If a cell is "yes" it needs to be yellow but only in columns G, I, K, M, O, however if its "yes" in column Q it needs to be green until a date is enter in column P, then both will turn yellow. (I have no idea how I could code that either)


Code:

Private Sub BTN_MovePending_Click()
Dim Maint As Worksheet
Dim NewBuild As Worksheet
Dim Pending As Worksheet


Set Maint = Sheet1
Set NewBuild = Sheet4
Set Pending = Sheet6


a = Worksheets("Maint").Cells(Rows.Count, 1).End(xlUp).Row


For i = 3 To a


If Worksheets("maint").Cells(i, 19).Value = "Pending" Then
Worksheets("Maint").Rows(i).Cut
Worksheets("Pending").Activate
b = Worksheets("Pending").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Pending").Cells(b + 1, 1).Select
ActiveSheet.Paste
Worksheets("Maint").Activate
End If
Next


Application.CutCopyMode = False


Maint.Activate


lastrow = Maint.Cells(Rows.Count, 1).End(xlUp).Row


Maint.Cells(2, 1).Select


For i = lastrow To 2 Step by - 1


If WorksheetFunction.CountA(Selection.Rows(i)) = 0 Then
Selection.Rows(i).EntireRow.Delete
End If

Next


End Sub

 

[Megan_NRC]

I've just come to realize that code to move rows from worksheet to worksheet doesn't work anyways
It goes as far as cutting the entire row, but it doesn't paste anywhere?

I'll have to re-write that one.

Again, thanks for all your knowledge and help! The lagging has decreased, but it still seems just a little too long for such a simple code.