How to speed up VBA Code

[Stealth]

I am new to working with VBA and have designed a Darts Score Sheet for my local League. I have written the following VBA Code to add an extra Row for lower grade players but due to the length of code it slows down the worksheet. Is there any way of condensing the mathematics to make the code run quicker. Any assistance would be appreciated.

Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect GeneralPassword
    If Range("AW29").Value = "1" Then
        Rows("30:30").EntireRow.Hidden = False
    ElseIf Range("AW29").Value = "" Then
        Rows("30:30").EntireRow.Hidden = True
    End If
    If Range("AW31").Value = "1" Then
        Rows("32:32").EntireRow.Hidden = False
    ElseIf Range("AW31").Value = "" Then
        Rows("32:32").EntireRow.Hidden = True
    End If
    If Range("AW33").Value = "1" Then
        Rows("34:34").EntireRow.Hidden = False
    ElseIf Range("AW33").Value = "" Then
        Rows("34:34").EntireRow.Hidden = True
    End If
    If Range("AW35").Value = "1" Then
        Rows("36:36").EntireRow.Hidden = False
    ElseIf Range("AW35").Value = "" Then
        Rows("36:36").EntireRow.Hidden = True
    End If
    If Range("AW37").Value = "1" Then
        Rows("38:38").EntireRow.Hidden = False
    ElseIf Range("AW37").Value = "" Then
        Rows("38:38").EntireRow.Hidden = True
    End If
    If Range("AW39").Value = "1" Then
        Rows("40:40").EntireRow.Hidden = False
    ElseIf Range("AW39").Value = "" Then
        Rows("40:40").EntireRow.Hidden = True
    End If
    If Range("AW41").Value = "1" Then
        Rows("42:42").EntireRow.Hidden = False
    ElseIf Range("AW41").Value = "" Then
        Rows("42:42").EntireRow.Hidden = True
    End If
    If Range("AW43").Value = "1" Then
        Rows("44:44").EntireRow.Hidden = False
    ElseIf Range("AW43").Value = "" Then
        Rows("44:44").EntireRow.Hidden = True
    End If
    If Range("AW45").Value = "1" Then
        Rows("46:46").EntireRow.Hidden = False
    ElseIf Range("AW45").Value = "" Then
        Rows("46:46").EntireRow.Hidden = True
    End If
    If Range("AW47").Value = "1" Then
        Rows("48:48").EntireRow.Hidden = False
    ElseIf Range("AW47").Value = "" Then
        Rows("48:48").EntireRow.Hidden = True
    End If
    If Range("AW49").Value = "1" Then
        Rows("50:50").EntireRow.Hidden = False
    ElseIf Range("AW49").Value = "" Then
        Rows("50:50").EntireRow.Hidden = True
    End If
    If Range("AW51").Value = "1" Then
        Rows("52:52").EntireRow.Hidden = False
    ElseIf Range("AW51").Value = "" Then
        Rows("52:52").EntireRow.Hidden = True
    End If
    If Range("AW53").Value = "1" Then
        Rows("54:54").EntireRow.Hidden = False
    ElseIf Range("AW53").Value = "" Then
        Rows("54:54").EntireRow.Hidden = True
    End If
    If Range("AW55").Value = "1" Then
        Rows("56:56").EntireRow.Hidden = False
    ElseIf Range("AW55").Value = "" Then
        Rows("56:56").EntireRow.Hidden = True
    End If
    If Range("AW57").Value = "1" Then
        Rows("58:58").EntireRow.Hidden = False
    ElseIf Range("AW57").Value = "" Then
        Rows("58:58").EntireRow.Hidden = True
    End If
    If Range("AW59").Value = "1" Then
        Rows("60:60").EntireRow.Hidden = False
    ElseIf Range("AW59").Value = "" Then
        Rows("60:60").EntireRow.Hidden = True
    End If
    If Range("AW61").Value = "1" Then
        Rows("62:62").EntireRow.Hidden = False
    ElseIf Range("AW61").Value = "" Then
        Rows("62:62").EntireRow.Hidden = True
    End If
    If Range("AW63").Value = "1" Then
        Rows("64:64").EntireRow.Hidden = False
    ElseIf Range("AW63").Value = "" Then
        Rows("64:64").EntireRow.Hidden = True
    End If
ActiveSheet.Protect GeneralPassword
        
End Sub

[mancubus]

welcome to the forum.

it's not the length only but the code itself.
this is a change event so it fires everytime you change a cell.
define the cells that you really want to trigger the event.f

below may give you an idea...

    If Target.Count > 1 Then Exit Sub
       'fire only when one cell is changed
    If Intersect(Target, Range("C1:C3")) Is Nothing Then Exit Sub
       'fire only when one cell in range C1:C3 is changed

    With Target
        If .Address = "$C$1" Then
           'code lines when C1 is changed
        ElseIf .Address = "$C$2" Then
           'code lines when C2 is changed
        ElseIf .Address = "$C$3" Then
           'code lines when C3 is changed
        End If
    End With

you can find many ways...

PS
for a noncontiguous range:

If Intersect(Target, Union(Range("C1"), Range("C5"), Range("C9")) Is Nothing Then Exit Sub

[Stealth]

Thanks mancubus, I will have to research what you have said as I really am new at this and thought that I had defined the actual cells I want to trigger.

[mancubus]

you're welcome.

if you don't explicitly define the "Target" cell, the event code triggers whenever a cell is changed.

if this is what you are after, that's ok. but in most of the cases there are some rules, restrictions, specifications. so design your code according to these rules. if you dont have any rules, you'd better review your Project.

[offthelip]

One of the main reasons that Vba is slow is the time taken to access the worksheet from VBa is a relatively long time.
To speed up vba the easiest way is to minimise the number of accesses to the worksheet. What is interesting is that the time taken to access a single cell on the worksheet in vba is almost identical as the time taken to access a large range if it is done in one action.
So instead of writing software that goes down a range checking one row at a time which will take along time if you have got 50000 rows it is much quicker to load the 50000 lines into a variant array ( one worksheet access), then check the vaalues in the variant array .
Your software check every cell twice in the 30 rows you are looking at. I have modified your software so that it loads all the dat into a varaint array and then check the array for the condition. This will speed it up regardless of whether you sort the target intersect bit out.

Private Sub Worksheet_Change(ByVal Target As Range)
    ActiveSheet.Unprotect GeneralPassword
    inarr = Range("AW1:Aw63")
    
If inarr(29, 1) = "1" Then
        Rows("30:30").EntireRow.Hidden = False
    ElseIf inarr(29, 1) = "" Then
        Rows("30:30").EntireRow.Hidden = True
    End If
If inarr(31, 1) = "1" Then
        Rows("32:32").EntireRow.Hidden = False
    ElseIf inarr(31, 1) = "" Then
        Rows("32:32").EntireRow.Hidden = True
    End If
If inarr(33, 1) = "1" Then
        Rows("34:34").EntireRow.Hidden = False
    ElseIf inarr(33, 1) = "" Then
        Rows("34:34").EntireRow.Hidden = True
    End If
If inarr(35, 1) = "1" Then
        Rows("36:36").EntireRow.Hidden = False
    ElseIf inarr(35, 1) = "" Then
        Rows("36:36").EntireRow.Hidden = True
    End If
If inarr(37, 1) = "1" Then
        Rows("38:38").EntireRow.Hidden = False
    ElseIf inarr(37, 1) = "" Then
        Rows("38:38").EntireRow.Hidden = True
    End If
If inarr(39, 1) = "1" Then
        Rows("40:40").EntireRow.Hidden = False
    ElseIf inarr(39, 1) = "" Then
        Rows("40:40").EntireRow.Hidden = True
    End If
If inarr(41, 1) = "1" Then
        Rows("42:42").EntireRow.Hidden = False
    ElseIf inarr(41, 1) = "" Then
        Rows("42:42").EntireRow.Hidden = True
    End If
If inarr(43, 1) = "1" Then
        Rows("44:44").EntireRow.Hidden = False
    ElseIf inarr(43, 1) = "" Then
        Rows("44:44").EntireRow.Hidden = True
    End If
If inarr(45, 1) = "1" Then
        Rows("46:46").EntireRow.Hidden = False
    ElseIf inarr(45, 1) = "" Then
        Rows("46:46").EntireRow.Hidden = True
    End If
If inarr(47, 1) = "1" Then
        Rows("48:48").EntireRow.Hidden = False
    ElseIf inarr(47, 1) = "" Then
        Rows("48:48").EntireRow.Hidden = True
    End If
If inarr(49, 1) = "1" Then
        Rows("50:50").EntireRow.Hidden = False
    ElseIf inarr(49, 1) = "" Then
        Rows("50:50").EntireRow.Hidden = True
    End If
If inarr(51, 1) = "1" Then
        Rows("52:52").EntireRow.Hidden = False
    ElseIf inarr(51, 1) = "" Then
        Rows("52:52").EntireRow.Hidden = True
    End If
If inarr(53, 1) = "1" Then
        Rows("54:54").EntireRow.Hidden = False
    ElseIf inarr(53, 1) = "" Then
        Rows("54:54").EntireRow.Hidden = True
    End If
If inarr(55, 1) = "1" Then
        Rows("56:56").EntireRow.Hidden = False
    ElseIf inarr(55, 1) = "" Then
        Rows("56:56").EntireRow.Hidden = True
    End If
If inarr(57, 1) = "1" Then
        Rows("58:58").EntireRow.Hidden = False
    ElseIf inarr(57, 1) = "" Then
        Rows("58:58").EntireRow.Hidden = True
    End If
If inarr(59, 1) = "1" Then
        Rows("60:60").EntireRow.Hidden = False
    ElseIf inarr(59, 1) = "" Then
        Rows("60:60").EntireRow.Hidden = True
    End If
If inarr(61, 1) = "1" Then
        Rows("62:62").EntireRow.Hidden = False
    ElseIf inarr(61, 1) = "" Then
        Rows("62:62").EntireRow.Hidden = True
    End If
If inarr(63, 1) = "1" Then
        Rows("64:64").EntireRow.Hidden = False
    ElseIf inarr(63, 1) = "" Then
        Rows("64:64").EntireRow.Hidden = True
    End If
    ActiveSheet.Protect GeneralPassword
     


End Sub

[snb]

Why not using autofilter ?

sub M_snb()
   columns(1).autofilter 1,1
End Sub

[p45cal]

One of these perhaps:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim HiddenRows As Range
Dim ShowingRows As Range
myVals = Range("aw1:aw63").Value
For rw = 29 To 63 Step 2
  If myVals(rw, 1) = 1 Then
    If ShowingRows Is Nothing Then Set ShowingRows = Cells(rw + 1, 1) Else Set ShowingRows = Union(ShowingRows, Cells(rw + 1, 1))
  ElseIf myVals(rw, 1) = "" Then
    If HiddenRows Is Nothing Then Set HiddenRows = Cells(rw + 1, 1) Else Set HiddenRows = Union(HiddenRows, Cells(rw + 1, 1))
  End If
Next rw
ActiveSheet.Unprotect GeneralPassword
If Not ShowingRows Is Nothing Then ShowingRows.EntireRow.Hidden = False
If Not HiddenRows Is Nothing Then HiddenRows.EntireRow.Hidden = True
ActiveSheet.Protect GeneralPassword
End Sub

Sub Worksheet_Change(ByVal Target As Range)
Dim CellsToCheckThisTime As Range, HiddenRows As Range, ShowingRows As Range
Set rngToCheck = Range("AW29 , AW31, AW33, AW35, AW37, AW39, AW41, AW43, AW45, AW47, AW49, AW51, AW53, AW55, AW57, AW59, AW61, AW63")
Set CellsToCheckThisTime = Intersect(Target, rngToCheck)
If Not CellsToCheckThisTime Is Nothing Then
  For Each cll In CellsToCheckThisTime.Cells
    If cll.Value = 1 Then
      If ShowingRows Is Nothing Then Set ShowingRows = cll.Offset(1) Else Set ShowingRows = Union(ShowingRows, cll.Offset(1))
    ElseIf cll.Value = "" Then
      If HiddenRows Is Nothing Then Set HiddenRows = cll.Offset(1) Else Set HiddenRows = Union(HiddenRows, cll.Offset(1))
    End If
  Next cll
  ActiveSheet.Unprotect GeneralPassword
  If Not ShowingRows Is Nothing Then ShowingRows.EntireRow.Hidden = False
  If Not HiddenRows Is Nothing Then HiddenRows.EntireRow.Hidden = True
  ActiveSheet.Protect GeneralPassword
End If
End Sub

Realise though, that if you put anything but a 1 or nothing in the cells being checked that the row below won't change its hidden property. The code could be shorter if you just checked for empty cells (or not).

[Stealth]

Thank you offthelip, this did reduce the time to activate the extra rows. Your assistance was really appreciated.

[Stealth]

Thank you p45cal, I tried both of your posts. The first one works really well but the second one didn't work at all. I have implemented your first post for trials by the dart league. Once again thank you for your assistance it is really appreciated.

[p45cal]

I tested both and they both work.
You didn't have them both at the same time in the same sheet-module dod you? Only one of them will work (usually the top one). To test the other, temporarily rename one of them, eg.:
Sub Worksheet_Change(ByVal Target As Range)
becomes:
Sub zzzWorksheet_Change(ByVal Target As Range)
then the remaining one will work.

[Stealth]

No p45cal I dont have them both in the same work sheet. I have 5 copies of the work sheet and have my original code in one, your codes in two and three, offthelip's in four and a modified original using mancubus's tips in five. Your top code works the fastest and I can't get your other code to work. Will try again tomorrow Australian time.

[p45cal]

…but the second one didn't work at all.

In the attached, one sheet, with the second macro in msg#7 copy/pasted into the sheet's code-module. Works fine here.

[SamT]

Interesting situation. Here's my 2 cents.

This is based on one premise, one assumption, and one presumption

• Presupposed that any Event Sub should only decide what other subs/functions to run. Do not Overload an Event sub such that it cannot coherently handle multiple events in different manners.
• Assumes that you don't care about changing all rows every time one cell is changed.
• Presumes that there may come a time when you want to reset all rows that can be hidden.

WorkSheet Code Module:

Private Sub Worksheet_Change(ByVal Target As Range)

'Deal only with changes to column AW in odd numbered Rows 29 to 63
If Mid(Target.Address, 2, 2) = "AW" _
  And Target.Row >= 29 And Target.Row <= 63 _
  And (Target.Row Mod 2 = 1) Then
  HideShowRows_AW Target
  Exit Sub
End If

'Deal with changes elsewhere if needed

End Sub

Standard Module:

Sub HideShowRows_AW(ByVal Target As Range)
Const GeneralPassword As String = "***" ' for debugging purposes

Application.EnableEvents = False
Application.ScreenUpdating = False
Target.Parent.Unprotect GeneralPassword
    
If CStr(Target) = "1" Then
  Target.Offset(1).EntireRow.Hidden = False
Else
  Target.Offset(1).EntireRow.Hidden = True
End If

Target.Parent.Protect GeneralPassword
Application.ScreenUpdating = True
Application.EnableEvents = True
        
End Sub


Public Sub HideAll_AW()
Const GeneralPassword As String = "***" ' for debugging purposes
Dim Rw As Long

Application.EnableEvents = False
Application.ScreenUpdating = False

With ActiveSheet
  .Unprotect GeneralPassword
  
  For Rw = 30 To 64 Step 2
    .Rows(Rw).Hidden = True
  Next
  
 .Protect GeneralPassword
End With

Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub

Public Sub ShowAll_AW()
Const GeneralPassword As String = "***" ' for debugging purposes
Dim Rw As Long

Application.EnableEvents = False
Application.ScreenUpdating = False

With ActiveSheet
  .Unprotect GeneralPassword
  
  For Rw = 30 To 64 Step 2
    .Rows(Rw).Hidden = False
  Next
  
 .Protect GeneralPassword
End With

Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub

Note that HideAll_AW, and ShowAll_AW are designed to be called from Excel's Macro menu, allowing the User to reset all hide-able rows to one condition or the other. This ignores "1"s in other cells.