Consulting

Results 1 to 2 of 2

Thread: Formula based on files in directory

  1. #1
    VBAX Tutor SJ McAbney's Avatar
    Joined
    May 2004
    Location
    Glasgow
    Posts
    243
    Location

    Formula based on files in directory

    I have a spreadsheet that collects information from a number of different spreadsheets in the same directory.

    It's one of those where one person has their own spreadsheet, another has theirs, etc. There is also a summary sheet that adds up the values over the different spreadsheets. Each sheet - including the summary has the same layout.

    The problem is that as people come and go their will need to be a different spreadsheet for each person detailing their workloads. I could manually change the summary spreadsheet's formulae but this is too time consuming and I don't, to be honest, trust those who'll be using it going forward to do this on their own.

    I've tried and played about with this code:

    Sub Button1_Click()
        Const strExtension As String = "\*.xls"
        Const bytMonth = 1
        Dim strFileList() As String
        Dim rng As Range, strTemp As String
        Dim strFileName As String
        Dim strPathName As String
        Dim intIndex As Integer
    strPathName = ActiveWorkbook.Path
    strFileName = Dir(strPathName & strExtension)
        While strFileName <> vbNullString
            ReDim Preserve strFileList(0 To intIndex)
            If Not strFileName Like "Summary*" Then
                strFileList(intIndex) = strFileName
            End If
            strFileName = Dir()
            intIndex = intIndex + 1
        Wend
        If intIndex = 0 Then
            MsgBox "No files found"
            Exit Sub
        End If
    Range("D8:N38").Select
        For Each rng In Selection
            strTemp = vbNullString
            For intIndex = 1 To UBound(strFileList)
                If Not strFileList(intIndex) = vbNullString Then
                    strTemp = strTemp & "'" & ActiveWorkbook.Path & "[" & strFileList(intIndex) & "]" & MonthName(bytMonth) & "'!" & rng.Address & ","
                End If
            Next intIndex
            strTemp = "=SUM(" & Left(strTemp, Len(strTemp) - 1) & ")"
            rng.Formula = strTemp
        Next
    End Sub
    The idea is that each cell within the range would provide a SUM formula or value (if need be).

  2. #2
    VBAX Mentor CBrine's Avatar
    Joined
    Jun 2004
    Location
    Toronto, Canada
    Posts
    387
    Location
    This code will cycle through and entire list of files that meet the *.xls criteria within the specified folder. You should be able to drop your formatting code into the area indicated.

    Private Sub CommandButton1_Click()
    Dim ws As Worksheet, Path As String
    Path = "C:\temp\"
    Set ws = ActiveSheet
    Filename = Dir(Path & "*.xls")
    Do Until Filename = ""
    Workbooks.Open Path & Filename
    Your code here
    Filename = Dir
    Loop
    End Sub
    The most difficult errors to resolve are the one's you know you didn't make.


Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •