How to speed up VBA Code

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.

Code:

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

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...

Code:

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:

Code:

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

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.

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. :)

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.

Code:

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

Why not using autofilter ?

Code:

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

One of these perhaps:

Code:

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

Code:

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).

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

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.

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.

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.

1 Attachment(s)

Quote:

Originally Posted by Stealth

…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.

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:

Code:

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:

Code:

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.