Hidden Cells

[ranswert]

I have the following code:

Sub HideAroundSelection()
Dim intRows As Integer
Dim intCols As Integer
Dim rngAbove As Range
Dim rngRight As Range
Dim rngBelow As Range
Dim rngLeft As Range


intRows = Selection.Rows.Count
intCols = Selection.Columns.Count
'MsgBox ("introws = " & intRows & vbLf & "intcols = " & intCols)
With Selection
Set rngAbove = .Cells(1, 1).Offset(-1, 0)
Set rngBelow = .Cells(1, 1).Offset(intRows, 0)
Set rngRight = .Cells(1, 1).Offset(0, intCols)
'Set rngLeft = .Cells(1, 1)

If rngAbove.Row <> 1 Then
Range(rngAbove.Offset(-1, 0), .Cells(1, 1). _
Offset((1 - .Cells(1, 1).Row))).EntireRow.Hidden = True
End If
If rngBelow.Row <> ActiveSheet.Rows.Count Then
Range(rngBelow.Offset(1, 0), rngBelow.Offset _
(ActiveSheet.Rows.Count - rngBelow.Row)).EntireRow.Hidden = True
End If
If rngRight.Column <> ActiveSheet.Columns.Count Then
Range(rngRight.Offset(0, 1), rngRight. _
Offset(0, ActiveSheet.Columns.Count -
rngRight.Column)).EntireColumn.Hidden = True
End If
'If rngLeft.Column <> 1 Then
'Range(rngLeft.Offset(0, -1), rngLeft. _
'Offset(0, 1 - rngLeft.Column)).EntireColumn.Hidden = True
'End If

End With
Set rngAbove = Nothing
Set rngRight = Nothing
Set rngBelow = Nothing
Set rngLeft = Nothing


End Sub

before this runs I have:

Sub stopautocalc()
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
End Sub

It still runs a little slow. Is there a way to speed it up?
Thanks

 

[Jim Cone]

Providing a description of what the code is supposed to do would help.
Also...
What version of Excel you are using (xl2007?) .
How long is "slow"?
How much data does the sheet contain?
Are there any objects on the sheet?
How big is the file?
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware
(Excel Add-ins / Excel Programming)




"ranswert"
wrote in message
I have the following code:

Sub HideAroundSelection()
Dim intRows As Integer
Dim intCols As Integer
Dim rngAbove As Range
Dim rngRight As Range
Dim rngBelow As Range
Dim rngLeft As Range


intRows = Selection.Rows.Count
intCols = Selection.Columns.Count
'MsgBox ("introws = " & intRows & vbLf & "intcols = " & intCols)
With Selection
Set rngAbove = .Cells(1, 1).Offset(-1, 0)
Set rngBelow = .Cells(1, 1).Offset(intRows, 0)
Set rngRight = .Cells(1, 1).Offset(0, intCols)
'Set rngLeft = .Cells(1, 1)

If rngAbove.Row <> 1 Then
Range(rngAbove.Offset(-1, 0), .Cells(1, 1). _
Offset((1 - .Cells(1, 1).Row))).EntireRow.Hidden = True
End If
If rngBelow.Row <> ActiveSheet.Rows.Count Then
Range(rngBelow.Offset(1, 0), rngBelow.Offset _
(ActiveSheet.Rows.Count - rngBelow.Row)).EntireRow.Hidden = True
End If
If rngRight.Column <> ActiveSheet.Columns.Count Then
Range(rngRight.Offset(0, 1), rngRight. _
Offset(0, ActiveSheet.Columns.Count -
rngRight.Column)).EntireColumn.Hidden = True
End If
'If rngLeft.Column <> 1 Then
'Range(rngLeft.Offset(0, -1), rngLeft. _
'Offset(0, 1 - rngLeft.Column)).EntireColumn.Hidden = True
'End If

End With
Set rngAbove = Nothing
Set rngRight = Nothing
Set rngBelow = Nothing
Set rngLeft = Nothing


End Sub

before this runs I have:

Sub stopautocalc()
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
End Sub

It still runs a little slow. Is there a way to speed it up?
Thanks

 

[ranswert]

The code is supposed to hide everything but the range of cell that I want
visible.
The sheet contains 62 ranges that are 30 rows by 24 columns. I have a tilte
on the first row and buttons on the second and third row that are unhidden
along with the range that I want unhidden. I have a procedure using a form
that selects a range and unhide it using "HideAroundSelection" procedure.
Then it unhides the top three rows to show the title and buttons.
I am using Excel 2003.
It runs long enough that the hourglass shows. I have other worksheets in
the same workbook using "HideAroundSelection" pocedure that also contain
buttons and they run fast.

 

[Don Guillett]

Not quite sure what you want but this will hide all rows and columns not
selected with the cursor.
Sub hideallbutselection()
Cells.Rows.Hidden = False
Cells.Columns.Hidden = False
With Selection
fr = .Cells(1, 1).Row
fc = .Cells(1, 1).Column
lr = .Rows.Count
lc = .Columns.Count
'MsgBox fr
'MsgBox fc
'MsgBox lr
'MsgBox lc
If fr <> 1 Then Rows(1 & ":" & fr - 1).Hidden = True
If fc <> 1 Then Range(Cells(fr, 1), Cells(fr, fc - 1)).EntireColumn.Hidden =
True
Range(Cells(fr + lr, 1), Cells(65536, 1)).EntireRow.Hidden = True
Range(Cells(1, fc + lc), Cells(1, 256)).EntireColumn.Hidden = True
End With
End Sub

 

[Dana DeLouis]

Just to share...It appears to me that Excel 2007 has a more serious bug than
in earlier versions in regards to a particular issue.
This code will corrupt Excel 2007
When testing routines to Reset the Used Range, we first corrupt the
worksheet with code that is similar to what the op is asking for.

Sub Demo()
Dim Rng As String

Range("A1:C3").Select
Rng = Selection.Address

Columns.EntireColumn.Hidden = True
Range(Rng).EntireColumn.Hidden = False

Rows.EntireRow.Hidden = True
Range(Rng).EntireRow.Hidden = False

Application.Goto Range("A1"), True
End Sub

Sub Reset()
Cells.EntireColumn.Hidden = False
Cells.EntireRow.Hidden = False
End Sub

 

[Dana DeLouis]

Don't know if this is any faster. One of a few ways...

Sub HideAroundSelection()
Dim r As String
Dim c As String

Application.ScreenUpdating = False
With Selection
.EntireColumn.Hidden = True
c = Cells.SpecialCells(12).EntireColumn.Address
.EntireColumn.Hidden = False

.EntireRow.Hidden = True
r = Cells.SpecialCells(12).EntireRow.Address
.EntireRow.Hidden = False

Range(r).EntireRow.Hidden = True
Range(c).EntireColumn.Hidden = True
End With
Application.ScreenUpdating = True
End Sub

Sub UnhideAll()
With Cells
.EntireRow.Hidden = False
.EntireColumn.Hidden = False
End With
End Sub