Macro to create new workbook based on values of other workbooks in a directory.

I have several workbooks in a directory.  I would like a macro (or other automated way) to go through each workbook in the directory and examine the values of the following cells:

L21, L39, L59 and L80

I want to know the cell with the smallest value.  I then would like the macro to paste the filename of the workbook in the first column and the following depending on which cell above is the smallest:

L21 = Linear
L39 = Quadratic
L59 = Cubic
L80 = Quartic

I have attached a sample input workbook and the output workbook.
Annotated code is really appreciated,
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Robberbaron (robr)Commented:
your input file has no values in Column L, rows 21,39,59,

do you mean find the type with lowest P inc in r2.  ie Column I  ?
justearthAuthor Commented:
Ha. Yes
justearthAuthor Commented:
To clarify, yes the original R2 value and then the increase in R2, column I, not L.

Robberbaron (robr)Commented:
attached is my test workbook with code in module  
Option Explicit
Sub ProcessFolder()

    Dim sFileFilter As String, sFolderName As String, sActionFile As String
    Dim wbAction As Workbook, wsAction As Worksheet
    Dim rOutput As Range
    Dim dMinVal As Double, sMinName As String
    Set rOutput = ActiveSheet.Range("A1")
    sFileFilter = "column*.xls?"
    sFolderName = "c:\ee"
    sActionFile = Dir$(sFolderName & "\" & sFileFilter, vbNormal)
    Do While sActionFile <> ""
        Set wbAction = Workbooks.Open(Filename:=sActionFile, ReadOnly:=True)
        Set wsAction = wbAction.Sheets("statpolyreg")
        'set initials
        dMinVal = wsAction.Range("I21").Value
        sMinName = "Linear"
        If dMinVal > wsAction.Range("I39").Value Then
            'adopt Quad
            dMinVal = wsAction.Range("I39").Value
            sMinName = "Quadratic"
        End If
        If dMinVal > wsAction.Range("I59").Value Then
            'adopt Quad
            dMinVal = wsAction.Range("I59").Value
            sMinName = "Cubic"
        End If
        If dMinVal > wsAction.Range("I80").Value Then
            'adopt Quad
            dMinVal = wsAction.Range("I80").Value
            sMinName = "Quartic"
        End If
        'save the result from this workbook
        rOutput.Value = sActionFile
        rOutput.Offset(0, 1) = sMinName
        'close the action book
        wbAction.Close (False)
        'move to next records
        Set rOutput = rOutput.Offset(1, 0)
        sActionFile = Dir$()
End Sub

Open in new window


Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
justearthAuthor Commented:
Thanks. This works well.
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.