Another Speed Problem!

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
 
J

J.E. McGimpsey

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

Stu

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

Stu

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
 
S

Stu

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
 
T

Tom Ogilvy

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
 
J

J.E. McGimpsey

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
 
T

Tom Ogilvy

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

Dana DeLouis

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
 
T

Tom Ogilvy

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

J.E. McGimpsey

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!
 
S

Stu

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

rene.lenaers

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