#1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 11,272
Default File lists

Have you put the TyrNow macro in the same code module as my code, and before
the Option Explicit?

If so, move Option Explicit in front of that macro.

--
HTH

Bob Phillips

"shfcook" wrote in
message ...

Well, the workbook is just your code at the moment...plus a kindof f2
and f9 routine for a selected range.

Basically I want to pull up a whole directory's worth of date stamped
file names, then using =CONCATENATE() pull up certain ranges within
each file...this gets to about 5000 formulae, then run the TryNow()
routine to convert the function into formulae pulling in values...

Sub TryNow()
Dim myCell As Range
On Error GoTo 0
For Each myCell In Selection
myCell.Formula = myCell.Value
Next myCell
End Sub

Option Explicit

Private cnt As Long
Private arfiles
Private level As Long

Sub Folders()
Dim i As Long
Dim sFolder As String
Dim iStart As Long
Dim iEnd As Long
Dim fOutline As Boolean

arfiles = Array()
cnt = -1
level = 1

'sFolder = "F:\Daily Record of performance performance\Oberon
Strategic\Archive\"
sFolder = "C:\"
ReDim arfiles(2, 0)
If sFolder < "" Then
SelectFiles sFolder
Application.DisplayAlerts = False
On Error Resume Next
Worksheets("Files").Delete
On Error GoTo 0
Application.DisplayAlerts = True
Worksheets.Add.Name = "Files"
With ActiveSheet
For i = LBound(arfiles, 2) To UBound(arfiles, 2)
If arfiles(0, i) = "" Then
If fOutline Then
Rows(iStart + 1 & ":" & iEnd).Rows.Group
End If
With .Cells(i + 1, arfiles(2, i))
Value = arfiles(1, i)
Font.Bold = True
End With
iStart = i + 1
iEnd = iStart
fOutline = False
Else
Hyperlinks.Add Anchor:=.Cells(i + 1, arfiles(2, i)), _
Address:=arfiles(0, i), _
TextToDisplay:=arfiles(1, i)
iEnd = iEnd + 1
fOutline = True
End If
Next
Columns("A:Z").ColumnWidth = 5
End With
End If
'just in case there is another set to group
If fOutline Then
Rows(iStart + 1 & ":" & iEnd).Rows.Group
End If

Columns("A:Z").ColumnWidth = 5
ActiveSheet.Outline.ShowLevels RowLevels:=1
ActiveWindow.DisplayGridlines = False

End Sub

'-----------------------------------------------------------------------
Sub SelectFiles(Optional sPath As String)
'-----------------------------------------------------------------------
Static FSO As Object
Dim oSubFolder As Object
Dim oFolder As Object
Dim oFile As Object
Dim oFiles As Object
Dim arPath

arfiles = Array()

If FSO Is Nothing Then
Set FSO = CreateObject("SCripting.FileSystemObject")
End If

If sPath = "" Then
sPath = CurDir
End If

arPath = Split(sPath, "\")
cnt = cnt + 1
ReDim Preserve arfiles(2, cnt)
arfiles(0, cnt) = ""
arfiles(1, cnt) = arPath(level - 1)
arfiles(2, cnt) = level

Set oFolder = FSO.GetFolder(sPath)
Set oFiles = oFolder.Files
For Each oFile In oFiles
cnt = cnt + 1
ReDim Preserve arfiles(2, cnt)
arfiles(0, cnt) = oFolder.Path & "\" & oFile.Name
arfiles(1, cnt) = oFile.Name
arfiles(2, cnt) = level + 1
Next oFile

level = level + 1
For Each oSubFolder In oFolder.Subfolders
SelectFiles oSubFolder.Path
Next
level = level - 1

End Sub

#If VBA6 Then
#Else
'-----------------------------**-----------------------------*-*------
Function Split(Text As String, _
Optional Delimiter As String = ",") As Variant
'-----------------------------**-----------------------------*-*------
Dim i As Long
Dim sFormula As String
Dim aryEval
Dim aryValues

If Delimiter = vbNullChar Then
Delimiter = Chr(7)
Text = Replace(Text, vbNullChar, Delimiter)
End If

sFormula = "{""" & Application.Substitute(Text, Delimiter, """,""") &
"""}"
aryEval = Evaluate(sFormula)
ReDim aryValues(0 To UBound(aryEval) - 1)
For i = 0 To UBound(aryValues)
aryValues(i) = aryEval(i + 1)
Next

Split = aryValues

End Function


'---------------------------------------------------------------------------
Public Function InStrRev(stringcheck As String, _
ByVal stringmatch As String, _
Optional ByVal start As Long = -1)

'---------------------------------------------------------------------------
Dim iStart As Long
Dim iLen As Long
Dim i As Long

If iStart = -1 Then
iStart = Len(stringcheck)
Else
iStart = start
End If

iLen = Len(stringmatch)

For i = iStart To 1 Step -1
If Mid(stringcheck, i, iLen) = stringmatch Then
InStrRev = i
Exit Function
End If
Next i
InStrRev = 0
End Function
'-----------------------------------------------------------------
#End If


--
shfcook
------------------------------------------------------------------------
shfcook's Profile:

http://www.excelforum.com/member.php...o&userid=27169
View this thread: http://www.excelforum.com/showthread...hreadid=467459



Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Can I make a spreasheet that lists every file in a direcory? Phil1982 Excel Discussion (Misc queries) 2 January 20th 06 07:39 PM
How to transfer info from PDF file to excel (lists)???????? [email protected] Excel Worksheet Functions 2 August 23rd 05 09:53 PM
Pivot tables, Validation Lists exist in an excel file Shimmy Excel Programming 1 June 16th 04 01:45 AM
Custom Lists file name Will Fleenor Excel Programming 0 June 8th 04 04:04 PM
Getting source lists w/o opening target file Arifi Koseoglu Excel Programming 5 May 25th 04 05:55 PM


All times are GMT +1. The time now is 06:57 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"