Efficiency in my code (a critique from the guru's)

[Wally Steadman]

Hello all,
I created a module that looks for files and then lists the file with the
full path name in Column A and then it lists just the file name in Column B.
It works well as this was just me learning VBA a bit more. I am sure it is
clunky and would love it if you guru's out there could look it over and send
me your thoughts and if there is a much more efficient way please let me
know so I can compare mine versus the efficient one and use that as a
learning tool some more. Code is listed below, I look forward to hearing
from you.
P.S. I have not done any error trapping so if you leave the input box blank,
it messes up but I will get to that part as well. I used *.xls as my
criteria since I am working with Excel.

Sub Dirtree()
Dim RC As Integer
Dim CC As Integer
RC = 1
Dim pos As Long
Dim cell As Range
Dim R1 As Range
Dim R2 As Range
Dim ExName As String

Worksheets(1).Range("A:B").Select
Selection.Delete

Set fs = Application.FileSearch
With fs
.NewSearch
.LookIn = "C:\"
.SearchSubFolders = True
.FILENAME = InputBox("Enter File type you are looking for, using the
*.extension format", "Filesearch")
.MatchTextExactly = True
.FileType = msoFileTypeAllFiles

If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
Worksheets(1).Cells(RC, 1) = .FoundFiles(i)
RC = RC + 1
Next i
Else
MsgBox "There were no files found."
End If
End With

Worksheets(1).Range("A:A").Copy
ActiveSheet.paste Destination:=Worksheets(1).Range("B:B")

Worksheets(1).Range("B:B").Select

For Each cell In Selection
pos = InStrRev(cell.Value, "\")
If pos > 0 Then
cell.Value = Right(cell.Value, Len(cell.Value) - pos)
End If
Next cell
Worksheets(1).Range("A:B").Sort _
Key1:=Worksheets(1).Range("B1")


End Sub


TIA

Wally Steadman

--
Walter Steadman
CW2, USA
124th Signal Battalion
Network Management Tech
(e-mail address removed)

 

[Tushar Mehta]

It might not be fast, but other than that the only improvements would be at
the margins.

One of the more inefficient interfaces (from a performance perspective) is
the VBA-XL one. You can dramatically speeden up your code by restricting the
number of worksheet updates. Use something like:

Option Explicit
Function NameOnly(fName As String)
Dim Pos As Integer
Pos = InStrRev(fName, "\")
If Pos > 0 Then
NameOnly = Right(fName, Len(fName) - Pos)
Else
NameOnly = fName
End If
End Function
Sub Dirtree()
Dim FS As FileSearch, I As Long, Rslt() As String
Worksheets(1).Range("A:B").Delete

Set FS = Application.FileSearch
With FS
.NewSearch
.LookIn = "c:\"
.SearchSubFolders = True
.Filename = InputBox( _
"Enter File type you are looking for, using the *.extension format",
"Filesearch")
.MatchTextExactly = True
.FileType = msoFileTypeAllFiles

If .Execute() > 0 Then
ReDim Rslt(1 To .FoundFiles.Count, 1 To 2)
For I = 1 To .FoundFiles.Count
Rslt(I, 1) = .FoundFiles(I)
Rslt(I, 2) = NameOnly(Rslt(I, 1))
Next I
Else
MsgBox "There were no files found."
End If
End With
Worksheets(1).Range("a1").Resize(UBound(Rslt, 1), 2).Value = Rslt
Worksheets(1).Range("A:B").Sort _
Key1:=Worksheets(1).Range("B1")
End Sub

The above ignores various safety concerns (one you have noted as well as
others such as too many files) as well as anecdotal comments from various
people about problems with FileSearch.

For a ready made solution, check
Directory List
http://www.tushar-mehta.com/excel/software/dirlist/index.html