View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
Neal Zimm Neal Zimm is offline
external usenet poster
 
Posts: 345
Default Testing/Finding .Hidden for Rows May21

Hi J,
You were so helpful I thought you might like to see the almost finished
function. I'm going to test whether scanning a row range is quicker than
If rows(row).Hidden Then ...

BTW, the code works, I've not yet found any problems with it.

On an older computer with a 386 chip, 5000 rows with 10 of them hidden
took .17 seconds.
The code is self-contained, I've replaced some of my other function calls
with GoSub's. (and hard coded MsoMaxRow and MSoMaxCol values.)

Thanks again.
Neal

Function HidnQtyF(ByVal Ws As Worksheet, bRowNum As Boolean, _
FMnumOrRng As Variant, TOnum As Long, Status As String, _
Optional bWantOutput As Boolean = False, _
Optional OutAyOrRng As Variant = "", _
Optional bExitFirHidn As Boolean = False, _
Optional INnumQty As Long = 0) As Long
'Outputs: Return count of hidden rows Xor columns, bRowNum input,
' True=scan for hidden rows, F= for columns.
' Optional array of hidden row/column numbers or a range bWantOutput
parm.
' If bWantOutput, the input OutAyOrRng parm type determines type of output.
' An unallocated array() or a range object. Ay output is base 1.
' Neither raises error 13, type mismatch.
' INnumQty is the input count of rows or columns being scanned, see bRowNum.
'
'Other Inputs: Ws sheet, if Nothing, Active is assumed.
' FMnumOrRng, a) Input range(Ws is set to .Parent) Areas.Count 1 is OK.
' b) From row or column #.
' c) Neither raises error 13 type mismatch.
' Tonum, the 'To' row/column # when FMnumOrRng is numeric. Lower to Higher
' or vice-versa is OK for scanning row or column #'s.
' bExitFirHidn, False, scan all input. True, Proc quits after 1st hidden
row or
' col is found. Output has only first item. Function return value will be
1.

'lockdown devel
Dim b1DimOut As Boolean
Dim bRangeIn As Boolean 'T= range input rather than FM and TO nums.

Dim RCAdr As String 'row(s) or column(s) string address

Dim Aix As Long 'area index
Dim Col1 As Long
Dim Col2 As Long
Dim FMnum As Long
Dim HiddenQty As Long
Dim InnerRC As Long 'inner loop row or column number
Dim MiscNum As Long 'miscell.
Const MSoMaxCol = 256 'todo, function, update values Excel 10,11,etc.
Const MSoMaxRow = 65536
Dim Qty As Long 'miscell.
Dim RC As Long 'row or column number
Dim ScanQty As Long 'row/col count in an area
Dim StepVal As Long 'up/down right/left row/col loops

'mainline start
Status = ""
INnumQty = 0

If IsNumeric(FMnumOrRng) Then 'f What's the input ?
If Ws Is Nothing Then Set Ws = ActiveSheet

ElseIf IsObject(FMnumOrRng) Then
If TypeName(FMnumOrRng) = "Nothing" Then
Status = "Warning, HidnQtyF, FMnumOrRng Input = Nothing"
Exit Function 'zip to scan
End If

If TypeName(FMnumOrRng) = "Range" Then
bRangeIn = True
Set Ws = FMnumOrRng.Parent
Else
Status = "Tech Error, HidnQtyF, FMnumOrRng Input Not Rng Obj"
Err.Raise 13
End If
Else
Status = "Tech Error, HidnQtyF, FMnumOrRng Input Not# Not Rng"
Err.Raise 13
End If

With Ws 'end with @ end sub

If Not bRangeIn Then '1 range, with from and to inputs.
FMnum = FMnumOrRng

If FMnum < 1 Then FMnum = 1
If TOnum < 1 Then TOnum = 1

If bRowNum Then
If FMnum MSoMaxRow Then FMnum = MSoMaxRow
If TOnum MSoMaxRow Then TOnum = MSoMaxRow
Else
If FMnum MSoMaxCol Then FMnum = MSoMaxCol
If TOnum MSoMaxCol Then TOnum = MSoMaxCol
End If

INnumQty = Abs(TOnum - FMnum) + 1
If FMnum <= TOnum Then StepVal = 1 Else StepVal = -1

If bWantOutput Then
ScanQty = INnumQty
GoSub AllocateOutP
End If

GoSub A_Ws_Scan 'f Main Loops

ElseIf bRowNum Then 'range input, 1 or more areas
For Aix = 1 To FMnumOrRng.Areas.Count
FMnum = FMnumOrRng.Areas(Aix).Row
TOnum = FMnum + FMnumOrRng.Areas(Aix).Rows.Count - 1
StepVal = 1
GoSub A_Ws_Scan
Next Aix
Else
For Aix = 1 To FMnumOrRng.Areas.Count
FMnum = FMnumOrRng.Areas(Aix).Column
TOnum = FMnum + FMnumOrRng.Areas(Aix).Columns.Count - 1
StepVal = 1
GoSub A_Ws_Scan
Next Aix
End If

If b1DimOut And HiddenQty 0 Then ReDim Preserve _
OutAyOrRng(1 To HiddenQty)
HidnQtyF = HiddenQty
'mainline end
Exit Function


A_Ws_Scan: 'Scan rows or columns, count, write outputs per function parms.

ScanQty = Abs(TOnum - FMnum) + 1
If bRangeIn Then INnumQty = INnumQty + ScanQty

If Not bWantOutput Then 'count only.
If bRowNum Then
For RC = FMnum To TOnum Step StepVal
If .Rows(RC).Hidden Then
HiddenQty = HiddenQty + 1
If bExitFirHidn Then Return
End If
Next RC
Else
For RC = FMnum To TOnum Step StepVal
If .Columns(RC).Hidden Then
HiddenQty = HiddenQty + 1
If bExitFirHidn Then Return
End If
Next RC
End If

ElseIf bRowNum Then 'Scan, write outputs, hidden rows
If bRangeIn Then GoSub AllocateOutP

For RC = FMnum To TOnum Step StepVal
If .Rows(RC).Hidden Then
If Not bExitFirHidn Then 'Scan all for hidden 'til input rows end.
If b1DimOut Then
HiddenQty = HiddenQty + 1
OutAyOrRng(HiddenQty) = RC 'f updated array

Else
InnerRC = RC
'f update range when contiguous hidden's end.
Do While .Rows(InnerRC + StepVal).Hidden And _
Abs(InnerRC + StepVal - FMnum + 1) <= ScanQty
InnerRC = InnerRC + StepVal
Loop

HiddenQty = HiddenQty + Abs(InnerRC - RC) + 1
RCAdr = RC & ":" & InnerRC
GoSub AddToOutRange

RC = InnerRC 'back to For/Next
End If 'updated range
Else
HiddenQty = 1
If b1DimOut Then
OutAyOrRng(1) = RC
Else
RCAdr = RC
GoSub AddToOutRange
End If
Return
End If 'f updated array or range
End If 'row is hidden
Next RC

Else 'Scan, write outputs, hidden columns
If bRangeIn Then GoSub AllocateOutP

For RC = FMnum To TOnum Step StepVal
If .Columns(RC).Hidden Then
If Not bExitFirHidn Then
If b1DimOut Then
HiddenQty = HiddenQty + 1
OutAyOrRng(HiddenQty) = RC

Else
InnerRC = RC

Do While .Columns(InnerRC + StepVal).Hidden And _
Abs(InnerRC + StepVal - FMnum + 1) <= ScanQty
InnerRC = InnerRC + StepVal
Loop

HiddenQty = HiddenQty + Abs(InnerRC - RC) + 1
'RCAdr = ColRngAdrF(RC, InnerRC) '$A:$B from col #'s
Col1 = RC
Col2 = InnerRC
GoSub ComposeColAdr
GoSub AddToOutRange

RC = InnerRC 'back to For/Next
End If 'updated range
Else
HiddenQty = 1
If b1DimOut Then
OutAyOrRng(1) = RC
Else
'RCAdr = ColRngAdrF(RC, RC)
Col1 = RC
Col2 = RC
GoSub ComposeColAdr
GoSub AddToOutRange
End If
Return
End If 'f updated array or range
End If 'row is hidden
Next RC
End If
Return


AddToOutRange: 'Set with Union or not
If bRowNum Then
If Not OutAyOrRng Is Nothing Then
Set OutAyOrRng = Union(OutAyOrRng, .Rows(RCAdr))
Else
Set OutAyOrRng = .Rows(RCAdr)
End If
Else
If Not OutAyOrRng Is Nothing Then
Set OutAyOrRng = Union(OutAyOrRng, .Columns(RCAdr))
Else
Set OutAyOrRng = .Columns(RCAdr)
End If
End If
Return

AllocateOutP: 'Dim/ReDim array to hold row or column #'s, Init Rng output.
If bRangeIn Then 'init on area 1, then redim array for +1 areas
If Aix = 1 Then
GoSub AllocateAy1st
ElseIf b1DimOut Then 'Be able to hold all items about to be scanned.
MiscNum = UBound(OutAyOrRng) - HiddenQty 'available elements
If ScanQty MiscNum Then
ReDim Preserve OutAyOrRng(1 To (UBound(OutAyOrRng) _
+ (ScanQty - MiscNum)))
End If
End If
Else 'one range of row or column #'s
GoSub AllocateAy1st
End If
Return

AllocateAy1st: 'First initialization
If IsObject(OutAyOrRng) And (TypeName(OutAyOrRng) = "Nothing" Or _
TypeName(OutAyOrRng) = "Range") Then
Set OutAyOrRng = Nothing

Else 'f Erase when more than 1 dimen, re-dim
If Not IsArray(OutAyOrRng) Then
Status = "Tech Error, HidnQtyF, Input OutAyOrRng, Not Rng Not Ay"
Err.Raise 13
End If

MiscNum = 0
Do
MiscNum = MiscNum + 1
On Error Resume Next
Qty = UBound(OutAyOrRng, MiscNum)
Loop Until Err.Number < 0
On Error GoTo 0
Qty = Qty - 1 'dimen of Ay

If 1 < Qty Then Erase OutAyOrRng
b1DimOut = True
ReDim OutAyOrRng(1 To ScanQty)
End If
Return

ComposeColAdr: 'string address via two col #'s
RCAdr = Range(Cells(1, Col1), Cells(1, Col2)).Address 'f $E$1:$F$1
RCAdr = Replace(RCAdr, "$1", "") 'f $E:$F
Return
End With 'With Ws at main top
End Function


--
Neal Z


"JLatham" wrote:

Second question First: the test of .Hidden for a range that includes several
rows will return the state of the first row in the range. With a range that
includes rows 1:10 and row 1 hidden, then it would return True. But if row 1
was visible and even all 9 other rows were hidden, it would return False.

So that results in the answer to your first question being pretty my "Yes"
you have to test each one individually as far as I know. For the best
performance, especially on a very large number of rows, you should use Range
objects to test. Some Examples:

We will assume that two variables are set up to hold the row numbers
involved: firstRow and lastRow

Dim testRows As Range
Dim anyRow As Range
Dim allHiddenFlag As Boolean
Set testRows = Rows(firstRow & ":" & lastRow)
'set default to assume all are hidden
allHiddenFlag = True
For Each anyRow In testRows
If anyRow.Hidden = False Then
allHiddenFlag=False
Exit For
End If
Next

'this setup would return the row number of the first hidden row
'in the range
Dim testRows As Range
Dim anyRow As Range
Dim firstHiddenRow As Long
Set testRows = Rows(firstRow & ":" & lastRow)
'set default to assume all are hidden
firstHiddenRow = 0
For Each anyRow In testRows
If anyRow.Hidden = trueThen
firstHiddenRow = anyRow.Row
Exit For
End If
Next
'test firstHiddenRow for non-zero

"Neal Zimm" wrote:

Hi All,
2 Questions follow,

This seems simple, but I'm not seeing it.
Below #2 is an excerpt from a bigger function.

1. Is there a quicker way to find rows that are hidden
within a larger row range, or is this about the
only way?
for row = x to y
if rows(row).hidden then .....
next row

I looked at .Find with the formats it can find but
.Hidden is a property, so , no go.


2. I do not understand why the If stmt below evaluated true
when all of rows 1 thru 10, inclusive, were not hidden.

Function Rows_HiddenQtyFV2(Ws As Worksheet, FMrow As Long, _
TOrow As Long, Optional bWantOutput As Boolean = False, _
Optional OutAyOrRng As Variant = "", _
Optional bExit1stHidn As Boolean = False, _
Optional INrowsQty As Long = 0) As Long


With Ws

INrowsQty = Abs(TOrow - FMrow) + 1

'FMrow was 10, TOrow was 1
' In the sheet rows 1 AND 10 were hidden, 2-9 not hidden.

If .Rows(FMrow & ":" & TOrow).Hidden = True Then
'more code here,
'don't all of them have to be hidden for "True"
End if

End With

'more code here to value the function
End Function

Thanks
--
Neal Z