ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Find method, special cells, home grown function (https://www.excelbanter.com/excel-programming/378162-find-method-special-cells-home-grown-function.html)

Neal Zimm

Find method, special cells, home grown function
 
Hi all,
The function below works fine, and it seems to run pretty quickly. I also
use it to find rows with data that are NOT at the very end of a worksheet.

#1. As I become more familiar with with the Find method I wonder how much
more efficient it would be versus what I've written. Your opinions? (I'm just
setting up a good timing mechanisim to test it, as I use the function a fair
amount.)

#2. Also, I've not yet tested whether or not the special cells type
xlcelltypeblanks means null or no "real" value. I have the requirement of
ignoring cells containing only spaces.

p.s. I use the SaveASU statements so I don't have to really keep track of
when I turn screen updating on or off.

Function Row_WsLastGetF(IWs As Worksheet, IHighRow As Long, _
IFromCol As Integer, IToCol As Integer) As Long
' Return the largest row# found with a value, starting from the
' IHighRow to row 1. A cell with only spaces is considered as
' having no value.
' Columns tested run from IFromCol to and including IToCol.
' 0 is returned for nothing found.
Dim SaveASU As Boolean, Col As Integer
SaveASU = Application.ScreenUpdating
Application.ScreenUpdating = False
With IWs
For Row_WsLastGetF = IHighRow To 1 Step -1
For Col = IFromCol To IToCol
If Trim(.Cells(Row_WsLastGetF, Col).Value) < "" Then GoTo Ending
Next Col
Next Row_WsLastGetF
Row_WsLastGetF = 0
Ending:
End With
Application.ScreenUpdating = SaveASU
End Function
--
Neal Z

Neal Zimm

Find method, special cells, home grown function
 
First time I've answered my own question. The two pieces of code below
illustrate that the find method kicks the crap out of a home grown loop
search.
the .find method, the first bit of code ran 17 times faster than the
second using two loops. The zTimermicro function is one I picked up on this
board, tho' I forget where.

Cheers.

BegSecs = zTimerMicro
With SyPws 'a worksheet
For Row = 3 To SyPlastRow - 1 '2000 rows
Text = .Cells(Row, Ix2SectCol).Value
If Len(Text) 0 Then
' .find to find the dupe text
Set DupeCell = .Range(Cells(Row + 1, Ix2SectCol), _
Cells(SyPlastRow, Ix2SectCol)).Find(What:=Text, _
LookIn:=xlValues, lookat:=xlWhole)
If Not DupeCell Is Nothing Then
Debug.Print Text & " found in rows " _
& Row & " and " & DupeCell.Row
Exit For
End If
End If
Next Row
End With
EndSecs = zTimerMicro
Debug.Print "Modified Find Meth. Time is " _
& (EndSecs - BegSecs) ' .23 seconds

BegSecs = zTimerMicro
With SyPws
For Row = 3 To SyPlastRow - 1
Text = .Cells(Row, Ix2SectCol).Value
If Len(Text) 0 Then
' second loop to find the dupe text
For DupeRow = Row + 1 To SyPlastRow
If Text = .Cells(DupeRow, Ix2SectCol).Value Then
Debug.Print Text & " found in rows " _
& Row & " and " & DupeRow
Exit For
End If
Next DupeRow
End If
Next Row
End With
EndSecs = zTimerMicro
Debug.Print "Second Loop Find Meth. Time is " _
& (EndSecs - BegSecs) ' 3.87 seconds
--
Neal Z


"Neal Zimm" wrote:

Hi all,
The function below works fine, and it seems to run pretty quickly. I also
use it to find rows with data that are NOT at the very end of a worksheet.

#1. As I become more familiar with with the Find method I wonder how much
more efficient it would be versus what I've written. Your opinions? (I'm just
setting up a good timing mechanisim to test it, as I use the function a fair
amount.)

#2. Also, I've not yet tested whether or not the special cells type
xlcelltypeblanks means null or no "real" value. I have the requirement of
ignoring cells containing only spaces.

p.s. I use the SaveASU statements so I don't have to really keep track of
when I turn screen updating on or off.

Function Row_WsLastGetF(IWs As Worksheet, IHighRow As Long, _
IFromCol As Integer, IToCol As Integer) As Long
' Return the largest row# found with a value, starting from the
' IHighRow to row 1. A cell with only spaces is considered as
' having no value.
' Columns tested run from IFromCol to and including IToCol.
' 0 is returned for nothing found.
Dim SaveASU As Boolean, Col As Integer
SaveASU = Application.ScreenUpdating
Application.ScreenUpdating = False
With IWs
For Row_WsLastGetF = IHighRow To 1 Step -1
For Col = IFromCol To IToCol
If Trim(.Cells(Row_WsLastGetF, Col).Value) < "" Then GoTo Ending
Next Col
Next Row_WsLastGetF
Row_WsLastGetF = 0
Ending:
End With
Application.ScreenUpdating = SaveASU
End Function
--
Neal Z



All times are GMT +1. The time now is 10:51 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com