Home |
Search |
Today's Posts |
|
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Can I make a spreasheet that lists every file in a direcory? | Excel Discussion (Misc queries) | |||
How to transfer info from PDF file to excel (lists)???????? | Excel Worksheet Functions | |||
Pivot tables, Validation Lists exist in an excel file | Excel Programming | |||
Custom Lists file name | Excel Programming | |||
Getting source lists w/o opening target file | Excel Programming |