Speeding up code

Damo10

Active Member
Joined
Dec 13, 2010
Messages
460
Hi,

I have the written the following code but it is slow to run which is causing the end users issues, is there anyway of speeding it up?
Any help would be much appreciated.

Code:
Sub CheckButtons()
 
AppStart
 
Lr = TransferSht.Range("B" & Rows.Count).End(xlUp).Row
 
y = 96 + Lr
 
For x = 101 To y 'Number of transfers on LoadPlan userform
    If AccessGroup < 2 Then
    Set Rng = TransferSht.Range(TransferSht.Range("B5"), TransferSht.Range("B" & Rows.Count).End(xlUp))
 
        For Each C In Rng
            If C.Offset(, 1).Text = "Y" And C = x Then
                For Each Ctrl In LoadPlan.Controls
                    If TypeName(Ctrl) = "CommandButton" Then
                        If Ctrl.Name = "btnPre" & x Then
                            Ctrl.Visible = True
                        End If
                        If Ctrl.Name = "btnInspect" & x Then
                            Ctrl.Visible = True
                        End If
                        If Ctrl.Name = "btnDesp" & x Then
                            Ctrl.Visible = True
                        End If
                        If Ctrl.Name = "btnTimes" & x Then
                            Ctrl.Visible = True
                        End If
                        If Ctrl.Name = "btnMissed" & x Then
                            Ctrl.Visible = True
                        End If
                    End If
                    If TypeName(Ctrl) = "Label" Then
                        If Ctrl.Name = "lbl" & x Then
                            Ctrl.Visible = True
                        End If
                    End If
                Next Ctrl
            End If
        Next C
        Set C = Nothing
    End If
   
    If AccessGroup > 1 Then
    Set Rng = TransferSht.Range(TransferSht.Range("B5"), TransferSht.Range("B" & Rows.Count).End(xlUp))
 
        For Each C In Rng
                For Each Ctrl In LoadPlan.Controls
                    If TypeName(Ctrl) = "CommandButton" Then
                        If Ctrl.Name = "btnPre" & x Then
                            Ctrl.Visible = True
                        End If
                        If Ctrl.Name = "btnInspect" & x Then
                            Ctrl.Visible = True
                        End If
                        If Ctrl.Name = "btnDesp" & x Then
                            Ctrl.Visible = True
                        End If
                        If Ctrl.Name = "btnTimes" & x Then
                            Ctrl.Visible = True
                        End If
                        If Ctrl.Name = "btnMissed" & x Then
                            Ctrl.Visible = True
                        End If
                    End If
                    If TypeName(Ctrl) = "Label" Then
                        If Ctrl.Name = "lbl" & x Then
                            Ctrl.Visible = True
                        End If
                    End If
                Next Ctrl
        Next C
        Set C = Nothing
    End If
 
    Set Rng = DataSht.Range(DataSht.Range("C5"), DataSht.Range("C" & Rows.Count).End(xlUp))
 
        For Each C In Rng
            If C.Text = LoadPlan.txtCal.Text And C.Offset(, 1) = x And C.Offset(, 62) = "Y" Then    'Changes missed trailer button to yellow if no reason known
                For Each Ctrl In LoadPlan.Controls
                    If TypeName(Ctrl) = "CommandButton" Then
                        If Ctrl.Name = "btnMissed" & x Then
                            Ctrl.BackColor = vbYellow
                            Ctrl.Caption = "Load " & C.Offset(, 35) & " Has Been Missed "
                            Ctrl.Width = 140
                            Ctrl.Left = 90
                            MissedLoadNum = "btnReason" & x
                        End If
                        If Ctrl.Name = MissedLoadNum Then
                            Ctrl.Visible = True
                            Ctrl.BackColor = vbYellow
                            Ctrl.Caption = "Reason Unknown"
                            Ctrl.Left = 250
                            Ctrl.Width = 100
                        End If
                    End If
                Next Ctrl
            End If
            If C.Text = LoadPlan.txtCal.Text And C.Offset(, 1) = x And C.Offset(, 62) = "Y" And C.Offset(, 36) <> Empty Then    'Changes missed trailer button to red if reason known
                For Each Ctrl In LoadPlan.Controls
                    If TypeName(Ctrl) = "CommandButton" Then
                        If Ctrl.Name = "btnMissed" & x Then
                            Ctrl.BackColor = vbRed
                            Ctrl.ForeColor = vbYellow
                            Ctrl.Left = 90
                        End If
                        If Ctrl.Name = MissedLoadNum And C.Offset(, 36) <> "" Then
                            Ctrl.Visible = True
                            Ctrl.BackColor = vbRed
                            Ctrl.ForeColor = vbYellow
                            Ctrl.Caption = C.Offset(, 36)
                            Ctrl.Left = 250
                            Ctrl.Width = 200
                        End If
                    End If
                Next Ctrl
            End If
            If C.Text = LoadPlan.txtCal.Text And CLng(C.Offset(, 1)) = x And C.Offset(, 50) = "Y" Then    'Changes pre-checks buttons green if checks completed
                For Each Ctrl In LoadPlan.Controls
                    If TypeName(Ctrl) = "CommandButton" Then
                        If Ctrl.Name = "btnPre" & x Then
                            Ctrl.BackColor = vbGreen
                            Ctrl.Caption = "Trailer No " & C.Offset(, 3)
                        End If
                    End If
                Next Ctrl
            End If
            If C.Text = LoadPlan.txtCal.Text And CLng(C.Offset(, 1)) = x And C.Offset(, 53) = "Y" Then    'Changes inspection buttons green if checks completed
                For Each Ctrl In LoadPlan.Controls
                    If TypeName(Ctrl) = "CommandButton" Then
                        If Ctrl.Name = "btnInspect" & x Then
                            Ctrl.BackColor = vbGreen
                        End If
                    End If
                Next Ctrl
            End If
            If C.Text = LoadPlan.txtCal.Text And CLng(C.Offset(, 1)) = x And C.Offset(, 56) = "Y" Then    'Changes despatch buttons green if checks completed
                For Each Ctrl In LoadPlan.Controls
                    If TypeName(Ctrl) = "CommandButton" Then
                        If Ctrl.Name = "btnDesp" & x Then
                            Ctrl.BackColor = vbGreen
                        End If
                    End If
                Next Ctrl
            End If
            If C.Text = LoadPlan.txtCal.Text And CLng(C.Offset(, 1)) = x And C.Offset(, 59) = "Y" Then    'Changes despatch times buttons green if checks completed
                For Each Ctrl In LoadPlan.Controls
                    If TypeName(Ctrl) = "CommandButton" Then
                        If Ctrl.Name = "btnTimes" & x Then
                            Ctrl.BackColor = vbGreen
                        End If
                    End If
                Next Ctrl
            End If
            If C.Text = LoadPlan.txtCal.Text And CLng(C.Offset(, 1)) = x And C.Offset(, 50) = "Y" And C.Offset(, 62) = "Y" Then 'Checks for missed trailer
                For Each Ctrl In LoadPlan.Controls
                    If TypeName(Ctrl) = "CommandButton" Then
                        If Ctrl.Name = "btnPre" & x Then
                            Ctrl.Visible = False
                        End If
                    End If
                Next Ctrl
            End If
            If C.Text = LoadPlan.txtCal.Text And CLng(C.Offset(, 1)) = x And C.Offset(, 53) = "Y" And C.Offset(, 62) = "Y" Then 'Checks for missed trailer
                For Each Ctrl In LoadPlan.Controls
                    If TypeName(Ctrl) = "CommandButton" Then
                        If Ctrl.Name = "btnInspect" & x Then
                            Ctrl.Visible = False
                        End If
                    End If
                Next Ctrl
            End If
            If C.Text = LoadPlan.txtCal.Text And CLng(C.Offset(, 1)) = x And C.Offset(, 56) = "Y" And C.Offset(, 62) = "Y" Then 'Checks for missed trailer
                For Each Ctrl In LoadPlan.Controls
                    If TypeName(Ctrl) = "CommandButton" Then
                        If Ctrl.Name = "btnDesp" & x Then
                            Ctrl.Visible = False
                        End If
                    End If
                Next Ctrl
            End If
            If C.Text = LoadPlan.txtCal.Text And CLng(C.Offset(, 1)) = x And C.Offset(, 59) = "Y" And C.Offset(, 62) = "Y" Then 'Checks for missed trailer
                For Each Ctrl In LoadPlan.Controls
                    If TypeName(Ctrl) = "CommandButton" Then
                        If Ctrl.Name = "btnTimes" & x Then
                            Ctrl.Visible = False
                        End If
                    End If
                Next Ctrl
            End If
            If C.Text = LoadPlan.txtCal.Text And CLng(C.Offset(, 1)) = x And C.Offset(, 50) = "Y" Then 'Hides Missed Transfer button if Pre-Checks have been completed
                For Each Ctrl In LoadPlan.Controls
                    If TypeName(Ctrl) = "CommandButton" Then
                        If Ctrl.Name = "btnMissed" & x Then
                            Ctrl.Visible = False
                        End If
                    End If
                Next Ctrl
            End If
            If C.Text = LoadPlan.txtCal.Text And CLng(C.Offset(, 1)) = x And C.Offset(, 62) = "Y" Then 'Hides Missed Transfer button if Pre-Checks have been completed
                For Each Ctrl In LoadPlan.Controls
                    If TypeName(Ctrl) = "CommandButton" Then
                        If Ctrl.Name = "btnPre" & x Then
                            Ctrl.Visible = False
                        End If
                        If Ctrl.Name = "btnInspect" & x Then
                            Ctrl.Visible = False
                        End If
                        If Ctrl.Name = "btnDesp" & x Then
                            Ctrl.Visible = False
                        End If
                        If Ctrl.Name = "btnTimes" & x Then
                            Ctrl.Visible = False
                        End If
                    End If
                Next Ctrl
            End If
        Next C
Next x
 
AppEnd
 
End Sub
Regards,

Damian
 

Some videos you may like

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"

mole999

Moderator
Joined
Oct 23, 2004
Messages
10,338
Office Version
2019, 2016, 2013
Platform
Windows
Re: Help with speeding up code

you could turn off screen updating and consider setting calculation to manual whilst it runs. without testing you might consider doing all the changes in one run, to test for each set of variables and do the action once, you might (i don't know), be able to hide all buttons first and just bring visible the ones you need
 

Damo10

Active Member
Joined
Dec 13, 2010
Messages
460
Re: Help with speeding up code

Hi,

Thanks for the reply.
I have screen updating turned off & calculation set to manual in the Appstart macro

I have tried splitting it down into sections but each section takes just over a second to run so when you add them all together it takes quite a while, is there anything else that would speed it up or a different approach?

This is one of the sections i have broken down

Code:
Sub CheckButtonsYV3()


AppStart


Lr = TransferSht.Range("B" & Rows.Count).End(xlUp).Row


y = 96 + Lr


For x = 101 To y 'Number of transfers on LoadPlan userform
    
    Set Rng = DataSht.Range(DataSht.Range("C5"), DataSht.Range("C" & Rows.Count).End(xlUp))


        For Each C In Rng
            
            If C.Text = LoadPlan.txtCal.Text And CLng(C.Offset(, 1)) = x And C.Offset(, 50) = "Y" Then    'Changes pre-checks buttons green if checks completed
                For Each Ctrl In LoadPlan.Controls
                    If TypeName(Ctrl) = "CommandButton" Then
                        If Ctrl.Name = "btnPre" & x Then
                            Ctrl.BackColor = vbGreen
                            Ctrl.Caption = "Trailer No " & C.Offset(, 3)
                        End If
                    End If
                Next Ctrl
            End If
            If C.Text = LoadPlan.txtCal.Text And CLng(C.Offset(, 1)) = x And C.Offset(, 53) = "Y" Then    'Changes inspection buttons green if checks completed
                For Each Ctrl In LoadPlan.Controls
                    If TypeName(Ctrl) = "CommandButton" Then
                        If Ctrl.Name = "btnInspect" & x Then
                            Ctrl.BackColor = vbGreen
                        End If
                    End If
                Next Ctrl
            End If
            
        Next C
Next x


AppEnd


End Sub
Regards,

Damian
 

Watch MrExcel Video

Forum statistics

Threads
1,099,082
Messages
5,466,535
Members
406,484
Latest member
kaksolver

This Week's Hot Topics

Top