Another Speed Problem!

  • Thread starter Thread starter Stu
  • Start date Start date
S

Stu

Hey guys, I have some more code that takes its time being ran, any ideas on
how to speed it up?

Here's the code:

Sub Year()

Dim Rng As Range
For Each Rng In
Range("B3:B21,B28:B45,B52:B69,B76:B93,B100:B117,B124:B141,B148:B165,B172:B18
9,B196:B213,B220:B237,B244:B261,B268:B285")
Rng(2, 1).EntireRow.Hidden = (Rng.Value = "")
Next Rng

End Sub

Thanks
 
One way:

Public Sub YearHide()
Dim hideRange As Range
For Each rng In Range("B3:B21,B28:B45,B52:B69," & _
"B76:B93,B100:B117,B124:B141,B148:B165," & _
"B172:B189,B196:B213,B220:B237,B244:B261,B268:B285")
If rng.Value = "" Then
If hideRange Is Nothing Then
Set hideRange = rng.Offset(1, 0)
Else
Set hideRange = Union(hideRange, rng.Offset(1, 0))
End If
End If
Next rng
If Not hideRange Is Nothing Then _
hideRange.EntireRow.Hidden = True
End Sub

Note that it's better to use macro names that are neither VBA nor XL
keywords or function names - cuts down on confusion.
 
Will that be right though? because I need this one to see what is in the B
column of the row above it so I'm not sure how to change it to do that
seeing as I am not too good with VB

Thanks
--
Stu
Tom Ogilvy said:
Change the code I offered to the last one and you should have it.

--
Regards,
Tom Ogilvy




Stu said:
Hey guys, I have some more code that takes its time being ran, any ideas on
how to speed it up?

Here's the code:

Sub Year()

Dim Rng As Range
For Each Rng In
Click to expand...
Range("B3:B21,B28:B45,B52:B69,B76:B93,B100:B117,B124:B141,B148:B165,B172:B18
Click to expand...
 
I did not know that Year is a VB or XL keyword or function. I have just
named my macros as to what they do.

Thanks
 
With this code it only works if the rows are unhidden at the start, how can
I get this to unhide aswell as hide?

thanks
 
Note that this is essentially the same code I provided to your previous
post. Different variable names.

Public Sub YearHide()
Dim hideRange As Range
Dim unhideRange As Range
Dim Rng As Range
For Each Rng In Range("B3:B21,B28:B45,B52:B69," & _
"B76:B93,B100:B117,B124:B141,B148:B165," & _
"B172:B189,B196:B213,B220:B237,B244:B261,B268:B285")
If Rng.Value = "" Then
If hideRange Is Nothing Then
Set hideRange = Rng.Offset(1, 0)
Else
Set hideRange = Union(hideRange, Rng.Offset(1, 0))
End If
Else
If unhideRange Is Nothing Then
Set unhideRange = Rng.Offset(1, 0)
Else
Set unhideRange = Union(unhideRange, Rng.Offset(1, 0))
End If
End If

Next Rng
If Not hideRange Is Nothing Then _
hideRange.EntireRow.Hidden = True
If Not unhideRange Is Nothing Then _
unhideRange.EntireRow.Hidden = False
End Sub
 
One way:

Public Sub YearHide()
Dim hideRange As Range
Dim rng As Range
Application.ScreenUpdating = False
With Range("B3:B21,B28:B45,B52:B69," & _
"B76:B93,B100:B117,B124:B141,B148:B165," & _
"B172:B189,B196:B213,B220:B237,B244:B261,B268:B285")
.EntireRow.Hidden = False
For Each rng In .Cells
If rng.Value = "" Then
If hideRange Is Nothing Then
Set hideRange = rng.Offset(1, 0)
Else
Set hideRange = Union(hideRange, rng.Offset(1, 0))
End If
End If
Next rng
End With
If Not hideRange Is Nothing Then _
hideRange.EntireRow.Hidden = True
Application.ScreenUpdating = True
End Sub
 
Wouldn't that miss at least 1 row in each section, such as B22, B46, B70,
etc.

And offseting the discontinuous range won't work in Excel 97, although it
will work in later versions.
 
Not sure if it's faster, but would any ideas here help? I hope I got the
logic right.

Sub YearHide()
'// Dana DeLouis
'// If a cell is blank, hide the row below

Dim rng As Range
Dim Remember As Boolean
Dim nRows As Long '# of Rows per area

Remember = Application.ScreenUpdating
Application.ScreenUpdating = False

On Error Resume Next
For Each rng In
Range("B3,B28,B52,B76,B100,B124,B148,B172,B196,B220,B244,B268").Cells
nRows = IIf(rng.Row = 3, 19, 18)
rng.Resize(nRows + 1).EntireRow.Hidden = False
rng.Resize(nRows).SpecialCells(xlCellTypeBlanks).Offset(1,
0).EntireRow.Hidden = True
Next rng

Application.ScreenUpdating = Remember
End Sub
 
Note that this won't work in Excel 97. May not be an issue, but important
to know.

--
Regards,
Tom Ogilvy

Dana DeLouis said:
Not sure if it's faster, but would any ideas here help? I hope I got the
logic right.

Sub YearHide()
'// Dana DeLouis
'// If a cell is blank, hide the row below

Dim rng As Range
Dim Remember As Boolean
Dim nRows As Long '# of Rows per area

Remember = Application.ScreenUpdating
Application.ScreenUpdating = False

On Error Resume Next
For Each rng In
Range("B3,B28,B52,B76,B100,B124,B148,B172,B196,B220,B244,B268").Cells
nRows = IIf(rng.Row = 3, 19, 18)
rng.Resize(nRows + 1).EntireRow.Hidden = False
rng.Resize(nRows).SpecialCells(xlCellTypeBlanks).Offset(1,
0).EntireRow.Hidden = True
Next rng

Application.ScreenUpdating = Remember
End Sub

--
Dana DeLouis
Using Windows XP & Office XP
= = = = = = = = = = = = = = = = =


Stu said:
Hey guys, I have some more code that takes its time being ran, any ideas on
how to speed it up?

Here's the code:

Sub Year()

Dim Rng As Range
For Each Rng In
Click to expand...
Range("B3:B21,B28:B45,B52:B69,B76:B93,B100:B117,B124:B141,B148:B165,B172:B18
Click to expand...
 
Yup. The line

.EntireRow.Hidden = False

should be deleted and the line

Range("4:286").EntireRow.Hidden = False

inserted after Application.ScreenUpdating = False, assuming that
none of the rows that fall outside Range("B3:B21,...,B268:B285)
should remain hidden. If that's not the case, use

Range("4:22,...,269:286).EntireRow.Hidden = False

Thanks for the correction, Tom!
 
Why do some of these not work in XL 97? Is there any reason for that?
Buts its ok to me seeing as I use XL2002.

Thanks
--
Stu


Tom Ogilvy said:
Note that this won't work in Excel 97. May not be an issue, but important
to know.

--
Regards,
Tom Ogilvy

Dana DeLouis said:
Not sure if it's faster, but would any ideas here help? I hope I got the
logic right.

Sub YearHide()
'// Dana DeLouis
'// If a cell is blank, hide the row below

Dim rng As Range
Dim Remember As Boolean
Dim nRows As Long '# of Rows per area

Remember = Application.ScreenUpdating
Application.ScreenUpdating = False

On Error Resume Next
For Each rng In
Range("B3,B28,B52,B76,B100,B124,B148,B172,B196,B220,B244,B268").Cells
nRows = IIf(rng.Row = 3, 19, 18)
rng.Resize(nRows + 1).EntireRow.Hidden = False
rng.Resize(nRows).SpecialCells(xlCellTypeBlanks).Offset(1,
0).EntireRow.Hidden = True
Next rng

Application.ScreenUpdating = Remember
End Sub

--
Dana DeLouis
Using Windows XP & Office XP
= = = = = = = = = = = = = = = = =


ideas
on
Click to expand...
Range("B3:B21,B28:B45,B52:B69,B76:B93,B100:B117,B124:B141,B148:B165,B172:B18
Click to expand...
 
Hiya,

You might also try working with arrays ; it is tremendously faster than
working on ranges.
Only problem, it does not work on ranges wich cover multiple areas.

So u could write someting like this (I havent tested it) :

dim T() as string
dim hiddenrows as range
dim i as integer

t = range("B3:B285").value ' u will get a 2 dimensionnal array
for i = 1 to ubound(t,1) ' number of rows is the first index of t
if needToTest(i) and t(i) = "" then
if hiddenrows is nothing then
set hiddenrows = cells(3+i+1,1).entirerow ' the array starts at 1 not
3
else
set hiddenrows = union(cells(3+i+1,1).entirerow, hiddenrows)
end if
end if
next i

hiddenrows.hidden = true

function needToTest(row as integer) as Boolean ' returns true if row is the
range that needs to be tested
if row < 19 or (row > 26 and row<43) or ... ' all the range conditions
dont forget there is an offset
neettotest = true
else
neettotest = false
end if
end function


Hope this helps

René.
 
Back
Top