Speeding up code

D

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
 

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying
Sort by date Sort by votes
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
 
Upvote 0
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
 
Upvote 0
You must log in or register to reply here.

Similar threads

H
  • Question
VBA Project, Copy enabled labels and textboxes from a userform to another userform
Replies
0
Views
189
HosEsf
H
P
  • Question
ListBox Click to textbox & delete row
Replies
0
Views
320
pure vito
P
A
  • Solved
Calendar form cancel button passing data to worksheet
Replies
7
Views
392
AndyEd
A
A
  • Solved
Calendar issue
Replies
1
Views
1K
AndyEd
A
L
  • Question
VBA works on work PC but not home PC
Replies
3
Views
2K
rollis13
rollis13

Forum statistics

Threads
1,214,826
Messages
6,121,794
Members
449,048
Latest member
greyangel23

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top