PDA

View Full Version : How to speed up VBA Code



Stealth
02-04-2018, 08:46 PM
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
02-04-2018, 11:23 PM
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
02-05-2018, 01:31 AM
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
02-05-2018, 03:36 AM
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
02-06-2018, 09:31 AM
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
02-06-2018, 09:48 AM
Why not using autofilter ?


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

p45cal
02-06-2018, 12:53 PM
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
02-07-2018, 03:36 AM
Thank you offthelip, this did reduce the time to activate the extra rows. Your assistance was really appreciated.

Stealth
02-07-2018, 03:40 AM
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
02-07-2018, 04:01 AM
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
02-07-2018, 04:58 AM
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
02-07-2018, 09:31 AM
…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
02-07-2018, 01:10 PM
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.